perm filename NETCON.MAC[IP,SYS]1 blob sn#690052 filedate 1982-12-09 generic text, type T, neo UTF8
TITLE NETCON	NETWORK CONTROL PROGRAM(NCP)	V 1576/576	
SUBTTL R SUNDBERG/RLS/EAT/EW13		AUGUST '74

;[96bit] edited in feb. 1980 by provan at cmu
;	 to handle 96 bit imp leaders

	SEARCH	F,S,i			;(236) search I.unv along with others

	$RELOC
	$HIGH

	XP VNETCN,577

;Local Revision History

;(147)	17-APR-78, Jim McCool
;	Edit Type: enhancment (in IMP code)
;	Modules Affected: IMPSER, SCNSER, COMCON, NETCON, I
;	Remove all support for old TELNET protocol.  Also add
;	a forced command invoked when an attempt is made to
;	perform an ICP on socket 1 which will tell the user that
;	we no longer support the old style TELNET.
;	Note that the forced command is only temporary until
;	a final announcement is made regarding the termination
;	of support for old style TELNET by DARPA.

;[96bit]7-Jul-80, Jim McCool
;	Modules effected: S, COMDEV, I, IMPINT, IMPSER, NETCON
;	Edit type: Enhancement
;	Add the CMU modifications to the ARPAnet code to support
;	96 bit leaders in the HOST-IMP protocol

;(234)	6-Jan-81, Jim McCool
;	Edit type: enhancement
;	Modules affected: IMPSER, NETCON
;	Description: Add code to count the occurences of the various types of
;	incomplete message transmission errors.

;(236)	8-jan-81, provan
;	edit type: enhancement
;	modules affected: I, ImpSer, NetCon
;	symptom: imp code is clumsy to compile.
;	diagnosis: I.mac is not a universal file.
;	cure: bring the imp code into the 1970's by making i.mac a universal.

;(241)	24-mar-81, provan
;	Edit type: enhancement
;	modules affected: comcon, scnser, netcon
;	description:  add finger command to run SYS:FINGER
;		add finger server socket for arpanet to run SYS:FINGER.

;(246)	12-oct-81, provan
;	modules affected: netcon
;	symptom: many programs need to know the first ITY.
;	cure: make the phst UUO function return it in the dev word.

;(260)	29-feb-82, provan
;	module affected: NetCon
;	symtom: ESB stopcds
;	diagnosis: monitor allows program to do IMPUUOs even
;		though the imp is down.  buffer space gets
;		eaten up until an ESB results.
;	cure: allow only certain UUOs to be executed when imp
;		is down.

;End of Local Revision History
ENTRY NETCON
NETCON:

EXTERN ITYGET,ITYREL,IMPN,IMPDDB,VIMPSR,OUBYTE,INBYTE
EXTERN HBFGET,HBFSIZ,OUTGO1,INTPJ,INTPJ1,INTTPJ,INTTP1
EXTERN IMPINX,IMPOXX,IMPTTY,IMPALL,IMPUP,OUTBYT,OUTBFO
EXTERN IMPDSP,LNKTST,RELBUF
EXTERN PIBYTE,PIHOST,PILINK,PISTAT,POBYTE,POHOST,POLINK,POSTAT
EXTERN PIALMS,PIALBT,PICPSK,PINSCT,PTLNOP,PSYNTM
SUBTTL PARAMETERS

;HOST-HOST PROTOCOL MESSAGES

.IMNOP==↑D0	;NO-OPERATION
.IMRTS==↑D1	;RECEIVER-TO-SENDER REQUEST FOR CONNECTION
.IMSTR==↑D2	;SENDER-TO-RECEIVER REQUEST FOR CONNECTION
.IMCLS==↑D3	;CLOSE CONNECTION
.IMALL==↑D4	;ALLOCATE BITS, MESSAGES FOR TRANSMISSION
.IMGVB==↑D5	;GIVE BACK ALLOCATION
.IMRET==↑D6	;RETURNED ALLOCATION(RESPONSE TO GVB)
.IMINR==↑D7	;INTERRUPT THE RECEIVING LINK SPECIFIED
.IMINS==↑D8	;INTERRUPT THE SENDING LINK SPECIFIED
.IMECO==↑D9	;ECHO THE ENCLOSED BYTE
.IMERP==↑D10	;ECHOED BYTE (RESPONSE TO ECO)
.IMERR==↑D11	;ERROR DETECTED
.IMRST==↑D12	;RESET ALL CONNECTIONS BETWEEN US
.IMRRP==↑D13	;RESET REPLY

.IMMAX==↑D13	;LARGEST MESSAGE TYPE IN THE PROTOCOL

;BITS FOR MESSAGES THAT ARE NOT "ACTIVITY" FOR THE PURPOSES OF
;   PURGING INACTIVE HOSTS.
INACTM==<1←.IMNOP>!<1←.IMECO>!<1←.IMERP>!<1←.IMRST>!<1←.IMRRP>


;SOME NCP MASKS

SK.JOB==↑O400		;FLAGS THAT THE HIGH ORDER FIELD IS THE JOB NUMBER
SK.LCL==↑O377		;LOCAL SOCKET FIELD
SUBTTL INPUT INTERRUPT

;HERE AT INPUT INTERRUPT LEVEL UPON RECEIPT OF
;  A MESSAGE ON THE NCP LINK.  F MUST CONTAIN THE
;  ADDRESS OF THE IMP DATA BLOCK. NO OTHER ACS NEED BE LOADED.
NCPINP::PUSHJ	P,SAVE4##	;SAVE THROUGH P4
	SETZB	P1,INBGET	;CLEAR HOST #, INPUT POINTER
	MOVEI	P4,INBYTE##	;TOP OF INPUT ROUTINE
Mesin0:	ScnOff			;LOCK ALL OUT before starting the loop
MESIN:	MOVEI	T1,0		;GET/CLEAR COROUTINE LINAGE
	EXCH	T1,INBGET
	SKIPE	T1
	MOVE	P4,T1
	MOVEI	F,NCPIDB	;NCP INPUT DDB
	PUSHJ	P,INXH8		; GET MESSAGE TYPE (first byte in T1)
	MOVE	P2,T1		;SAVE OP CODE
	CAILE	P2,.IMMAX	;LEGAL MESSAGE TYPE?
	JRST	MESINR		;NO
	pushj	p,bufhst##	;[96bit] get the host number for the
				;	 current buffer into T1
	jumpe	t1,mesinr	;[96bit] pessimism
	move	p1,t1		;[96bit] put it in a safe place
	PUSHJ	P,HOSTOK	;TELL ABOUT A GOOD HOST
	  TLO	P2,-1		;FLAG RESET IN PROGRESS (MOST MESSAGE
				;   TYPES DISCARDED).
MESIN1:	AOS	RECMES(P2)	;COUNT IT
;[96bit]CAIL	P2,MESDSN	;DISPATCH
	movei	t1,mesdsn	;[96bit] table break
	caig	t1,(p2)		;[96bit] is this in the second half?
	SKIPA	T1,MESDSP-MESDSN(P2)
	MOVS	T1,MESDSP(P2)
	JRST	(T1)

MESINR:	AOS	ILLMES

;HERE TO THROW AWAY A WHOLE MESSAGE
MESINZ:	PUSHJ	P,INXHZ		;EMPTY THE STREAM (WILL NEVER RETURN)
IFN DEBUG,<			;BUT...
	STOPCD	MESINX,STOP,IZR, ;++INXHZ RETURNED
>

;HERE WHEN INPUT STREAM EXHAUSTED
MESINX:	SETZM	INBGET		;NO MORE MESSAGES
	JRST	INTPJ##		;RETURN
;DISPATCH TABLE.

;THIS TABLE IS HAND BUILT TO COINCIDE WITH THE NETWORK HOST-HOST
;  PROTOCOL.  THE CODES INCREASE DOWN THE LEFT SIDE THEN
;  CONTINUE DOWN THE RIGHT SIDE.
;  NOTE THAT UNUSED CODES ARE PROVIDED FOR SOME EASY EXPANSION.

MESDSP:	MESIN	,,	ECOS
	RTSS	,,	ERPS
	STRS	,,	ERRS
	CLSS	,,	RSTS
	ALLS	,,	RRPS
	GVBS	,,	MESIN
	RETS	,,	MESIN
	INRS	,,	MESIN
	INSS	,,	MESIN

	MESDSN==.-MESDSP
COMMENT \

SOCKET STATES:		(POINTERS ARE PISTAT FOR INPUT AND POSTAT
				 FOR OUTPUT)


NOTE--	THREE LETTER MNEMONICS REFER TO NCP COMMANDS FROM A
REMOTE HOST.  THEY WILL ALWAYS BE HANDLED AT INTERRUPT LEVEL.
FOUR OR MORE LETTERS REFER TO A USER ACTIVITY(UUO OR COMMAND).
FOR A DESCRIPTION OF THE UUOS, SEE THE APPROPRIATE SECTION BELOW.

STATE		DESCRIPTION		ACTION EXPECTED
-----		-----------		--------------\
.ISCLS== ↑D0	;CLOSED			LISTEN, CONNECT
.ISLSN== ↑D1	;LISTENING		FLUSH, RFC
.ISRCN== ↑D2	;RFC IN			CLS, REJECT, ACCEPT, FLUSH
.ISABT== ↑D3	;RFC ABORT		ACCEPT, REJECT, FLUSH
.ISRCW== ↑D4	;RFC WAIT		CLS, RFC
.ISOPN==: ↑D5	;OPEN			CLS, CLOSE
.ISCLW== ↑D6	;CLS WAIT		CLS
.ISRMW== ↑D7	;CLS RFNM WAIT		RFNM
.ISRMI== ↑D8	;ICP RFNM WAIT		RFNM
.ISCLD== ↑D9	;REMOTE CLOSE RECEIVED	INPUT UUO
		;  AFTER DATA

.ISMAX== ↑D9	;HIGHEST LEGAL STATE NUMBER

DEFINE TABERR(T,INST)<
..N==.-'T'-.ISMAX-1
IFL ..N,<REPEAT -..N,<
IFB <INST>,<
	JFCL
>
IFNB <INST>,<
	INST
>>>
IF2,<
IFN <.-'T'-.ISMAX-1>,<PRINTX DISPATCH TABLE ERROR -- 'T'>>>
;REQUEST FOR CONNECTION -- RTS AND STR

COMMENT \

RTS AND STR ARE THE RFCS FROM THE RECEIVER AND SENDER, RESPECTIVELY.
THE ACTIONS OF THE TWO HANDLING ROUTINES ARE:
1.	GET THE "HIS SOCKET" FIELD OF THE COMMAND
	AND TEST FOR THE CORRECT LOW ORDER BIT.
2.	GET THE "MY SOCKET" FIELD OF THE MESSAGE
	AND TEST THE LOW ORDER BIT.
3.	IN THE CASE OF RTS, GET AND TEST THE "LINK" FIELD OF THE
	COMMAND.
	IN THE CASE OF STR, GET AND TEST THE BYTE SIZE.
4.	CALL A COMMON HANDLING ROUTINE(RFCS).
5.	IF ERROR RETURN FROM RFCS, WRAP UP AND GET NEXT BLOCK.
6.	IF SUCCESSFUL RETURN FROM RFCS, MANIPULATE ARGUMENTS
	AND GET NEXT BLOCK.
\

RTSS:
	jumpl	p2,flsh72	;[96bit] flush if reset out
	PUSHJ	P,INXH32	;GET HIS RECEIVE SOCKET
	MOVEM	T1,P3		;SAVE FOR LATER
	PUSHJ	P,INXH32	;GET MY SOCKET NUMBER
	movem	t1,p2		;[96bit] save my socket
	PUSHJ	P,INXH8		;GET LINK NUMBER
	CAIL	T1,LNKMIN	;LEGAL?
	CAILE	T1,LNKMAX
	JRST	RTSSE1		;NO, COUNT BAD LINK NUMBER AND IGNORE IT
	TRNE	P2,1		;CHECK SOCKET GENDER
	TRNE	P3,1
	JRST	MESIN		;BAD
	push	p,t1		;[96bit] save link number for RFCS
	PUSHJ	P,RFCS		;DO COMMON STUFF
	  JRST	rtsse2		;[96bit] ERROR OR LISTENING. ON TO NEXT
	pop	p,t1		;[96bit] recover link
	DPB	T1,POLINK	;PUT IN DDB
	JRST	MESIN

;HERE IF LINK NUMBER WAS BAD IN RTS.
RTSSE1:	aosa	badlnk		;[96bit] count it and skip to MESIN

;[96bit] some difficulty: clean up the stack and try again
rtsse2:	pop	p,t1		;[96bit] clear stack
	jrst	mesin		;[96bit] back for more
STRS:
	jumpl	p2,flsh72	;[96bit] flush if reset out
	PUSHJ	P,INXH32	;GET HIS SEND SOCKET
	MOVEM	T1,P3
	PUSHJ	P,INXH32	;GET MY RECEIVE SOCKET
	movem	t1,p2		;[96bit] save
	PUSHJ	P,INXH8		;GET BYTE SIZE
	TRNN	P2,1		;CHECK SOCKET GENDER
	TRNN	P3,1
	JRST	MESIN
	push	p,t1		;[96bit] save byte size
STRS0:	PUSHJ	P,RFCS		;DO COMMON STUFF
	  JRST	rtsse2		;[96bit] CLOSED OR LISTENING
	pop	p,t1		;[96bit] restore byte size
	DPB	T1,PIBYTE	;SAVE IT IN CASE NOT USER SPECIFIED
	MOVEI	T1,.ALBTS	;STANDARD INITIAL ALLOCATION
	MOVEI	T2,.ALMSS	;MESSAGE ALLOCATION
	PUSHJ	P,PALL
	PUSHJ	P,OUTXX
	JRST	MESIN		;HANDLE NEXT BLOCK.
COMMENT \
RFCS IS A ROUTINE COMMON TO RTSS AND STRS. IT DOES THE FOLLOWING:

1.	SEARCHES ALL ACTIVE DDBS FOR A MATCH BETWEEN P3 AND
	THE DDB "OUTPUT HIS SOCKET" FIELD IF THE CONTENTS OF P3 ARE
	EVEN, AND THE "INPUT HIS SOCKET" FIELD IF THE CONTENTS
	ARE ODD.  IF THE "MY SOCKET" IS THE EXEC, THE DDBS ARE
	SEARCHED FOR A MATCH TO "HIS SOCKET" AND "HIS SOCKET".XOR.1.
	IF THERE IS NO MATCH, A FREE DDB IS USED.
2.	IF THE DDB IS NOT FOUND, A "CLS" CONTROL BLOCK IS SENT
	AND A NON-SKIP RETURN IS TAKEN TO THE CALLER.
3.	IF THE SOCKET IS IN THE "LISTEN" STATE(1), THE "MY" AND "HIS"
	FIELDS ARE DEPOSITED IN THE F, THE STATE IS CHANGED TO
	"RFC IN"(2), THE JOB IS AWAKENED IF NECESSARY, AND THE SKIP
	RETURN IS TAKEN.
4.	IF THE SOCKET IS IN THE "RFC WAIT" STATE(4), THE "HIS SOCKET"
	FIELD OF THE MESSAGE IIS COMPARED WITH THE APPROPRIATE
	FIELD OF THE DDB.  IF THEY DO NOT MATCH, A "CLS" IS SENT AND
	THE NON-SKIP RETURN IS TAKEN.
5.	IF THERE IS A MATCH, THE STATE IS CHANGED TO "OPEN"(5),
	THE JOB IS AWAKENED, IF NECESSARY, AND THE DOUBLE SKIP RETURN
	IS TAKEN.

CALL:
	PUSHJ	P,RFCS
	  HERE IF CAN'T BE ACCEPTED, CLS SENT
	       OR IF LISTENING BUT NOT YET ACCEPTED
	HERE IF ACCEPTED AND SOCKET OPENED

\
RFCS:	;[96bit] byte size (for STRS) or link number (for RTSS) or
	;	 on the stack at -1(P)
	PUSHJ	P,NDBSTI	;SET UP U, P4  FOR OUTPUT
	PUSHJ	P,DDBFND	;FIND THE DDB
	  JRST	RFCS1A		;IMPERFECT MATCH
	CAIN	T1,.ISLSN	;FULL MATCH, LISTENING?
	JRST	RFCS2		;YES.
	CAIE	T1,.ISRCW	;RFC WAIT?
	JRST	CLSSE1		;NO.
	PUSHJ	P,BYTCHK	;YES, MAKE SURE BYTE SIZES AGREE
	  JRST	CLSS8		;THEY DON'T, CLOSE IT.
	JRST	RFCS3		;GOOD MATCH

;HERE IF IMPERFECT MATCH
RFCS1A:	JUMPE	F,RFCS1B	;JUMP IF NOTHING AT ALL
	CAIN	T1,.ISLSN	;LISTENING?
	JRST	RFCS2		;YES
	PJRST	CLSSE2		;CLOSE IT

;HERE IF CANT FIND DDB
RFCS1B:	CAIG	P2,ICPMAX	;ICP OUTPUT SOCKET?
	TRNN	P2,1
	JRST	CLSSE2		;NO
	PUSHJ	P,ICPRFC	;YES.  HANDLE IT.
	  JRST	CLSSS		;ERROR
	JRST	RFCS3		;GOOD FINISH
;HERE IF SOCKET IS LISTENING AND THERE ARE NO CONFLICTS.
;  THE EXEC SOCKETS WILL NEVER GET HERE SINCE THE THE EXEC
;  SOCKETS ARE NEVER PLACED IN A LISTENING STATE
RFCS2:	PUSHJ	P,BYTCHK	;MAKE SURE BYTE SIZES AGREE
	  JRST	CLSSE2		;THEY DON'T, REFUSE THE CONNECTION

;HERE IF NO CONFLICTS AT ALL
RFCS2C:	PUSHJ	P,GETREQ
	movem	p1,.rqhst(t1)	;[96bit] save host number in rfc queue
	move	t2,-1(p)	;[96bit] recall the byte size
	movem	t2,.rqbyt(t1)	;[96bit] save byte size
	movem	p3,.rqsoc(t1)	;[96bit] save socket number
	JRST	RFCS4

;HERE IF BOTH SOCKETS MATCH
RFCS3:	MOVEI	T1,.ISOPN
	AOSA	(P)		;SKIP
RFCS4:	MOVEI	T1,.ISRCN	;STATE TO RFC IN
	PUSHJ	P,SETSTT	;SET NEW STATE
	PUSHJ	P,NCPIOD	;TELL HIM ALL DONE
	MOVEI	T1,EXCFLG	;EXEC SERVER SOCKET?
	TDNN	T1,IMPIOS(F)
	POPJ	P,		;NO.  RETURN
	TRC	P2,1		;YES.  MUST BE OPEN.
	PUSHJ	P,GETSTT	;GET STATE OF OTHER SIDE
	TRC	P2,1		;PUT IT BACK
	CAIE	T1,.ISOPN	;OPEN TOO?
	POPJ	P,		;NO
	ScnOn			; allow interrupts so ScnSer has control
	pushj	p,icplog	; handle the ICP
	ScnOff			; grab the interlock again
	popj	p,		; return


;ROUTINE TO CHECK AN INCOMING RFC FOR CORRECT BYTE SIZE SPECIFICATION
;   IF THE LOCAL SOCKET IS IN THE LISTEN OR RFC OUT STATE.
;	MOVE	P1,[HOST] ;OF INCOMING RFC
;	byte size is at -2(P)		;[96bit]
;	MOVE	P2,[LOCAL SOCKET]
;	PUSHJ	P,BYTCHK
;	  ERROR--NO MATCH
;	NORMAL RETURN

BYTCHK:	TRNE	P2,1		;OUTPUT SOCKET?
	JRST	CPOPJ1		;YES, RTS SPECIFIES LINK, NOT BYTE SIZE
	LDB	T2,PIBYTE	;GET BYTE SIZE SPECIFIED IN DDB
	came	t2,-2(p)	;[96bit] does it match the one sent?
	JUMPN	T2,CPOPJ	;YES, ERROR RETURN IF DDB BYTESIZE SPECIFIED
	JRST	CPOPJ1		;NO, TAKE SKIP RETURN
COMMENT \

ON RECEIPT OF A "CLS" CONTROL BLOCK, THE FOLLOWING ACTION
IS TAKEN:

1.	THE TWO SOCKET FIELDS ARE CHECKED FOR OPPOSITE LOW ORDER BITS.
	IF THEY ARE THE SAME, AN ERROR BLOCK IS SENT
2.	THE DDBS ARE SEARCHED FOR A MATCH TO THE "MY SOCKET" FIELD
	OF THE BLOCK.  THE "MY RECEIVE SOCKET" FIELD OF THE DDB
	IS USED IF IT IS EVEN AND THE "MY TRANSMIT SOCKET" FIELD
	IS USED IF ODD.  IF "MY SOCKET" IS MY EXEC, A MATCH IS SOUGHT
	FOR "HIS SOCKET".
3.	IF A DDB IS NOT FOUND, AN ANSWERING CLS IS SENT(AND PERHAPS AN
	ERROR BLOCK), AND THE NEXT BLOCK IS HANDLED.
4.	IF THE DDB IS FOUND, THE BLOCK "HIS SOCKET" FIELD IS COMPARED WITH
	THE APPROPRIATE FIELD IN THE DDB.  IF THEY DO NOT MATCH, THE
	ANSWERING "CLS"(AND ERROR BLOCK?) IS SENT AND THE NEXT BLOCK
	HANDLED.
5.	IF THE SOCKET STATE IS "RFC IN", IT IS CHANGED TO "ABORT"
	AND THE ANSWERING CLS IS SENT.
6.	IF THE STATE IS "RFC WAIT", IT IS CHANGED TO CLOSED AND
	AND THE ANSWERING CLS SENT.
7.	IF THE STATE IS "OPEN", THE "MY SOCKET" FIELD IS ODD
	(OUTPUT) AND THE RFNM WAIT BIT IS SET, THE STATE IS CHANGED
	TO "RFNM WAIT". IF THE RFNM WAIT  BIT IS NOT SET, AN ANSWERING
	CLS IS SENT AND THE STATE SET TO "CLOSED".
8.	IF THE STATE IS "OPEN" AND THE "MY SOCKET" FIELD IS EVEN
	(INPUT), THE STATE IS CHANGED TO "CLOSED"(0), A "CLS" IS SENT,
	AND THE CLOSE SOCKET BIT(SKTCLS) IS SET.
9.	IF THE STATE IS "CLS WAIT"(6), THE STATE IS CHANGED TO
	"CLOSED"(0) AND THE CLOSE SOCKET BIT IS SET.
10.	IF NONE OF THE ABOVE ARE DONE, SEND AN ANSWERING "CLS".
\
CLSS:
	jumpl	p2,flsh64	;[96bit] flush if reset out
	PUSHJ	P,INXH32	;GET HIS SOCKET
	MOVEM	T1,P3
	PUSHJ	P,INXH32	;GET MY SOCKET
	MOVEM	T1,P2		;SAVE IT
	XOR	T1,P3		;DIFFERENT LOW ORDER BITS?
	TRNN	T1,1
	JRST	MESIN		;NO, IGNORE IT
	PUSHJ	P,NDBSTI	;SET UP U, P4 FOR OUTPUT
	PUSHJ	P,DDBFND	;FIND THE DDB
	  JRST	CLSS1		;IMPERFECT MATCH
IFN DEBUG,<
	CAILE	T1,.ISMAX
	STOPCD	MESIN,DEBUG,ISC, ;++IMPROPER STATE ON CLOSE
>
	XCT	CLSSD(T1)	;HANDLE DIFFERENT STATES
	JRST	MESIN

;HERE ON ERRORS THAT CAUSE THE 'CLS' SIMPLY TO BE IGNORED
CLSSE3:	AOSA	BADSTT		;INCREMENT BAD STATE COUNT
CLSSE4:	AOS	BADDDB		;INCREMENT SOCKET NOT FOUND COUNT
	JRST	MESIN

CLSSD:	JRST	CLSSE3		;0	CLOSED
	JRST	CLSSE3		;1	LISTENING
	PUSHJ	P,CLSS6		;2	RFC IN
	JRST	CLSSE3		;3	ABORT
	PUSHJ	P,CLSS4		;4	RFC WAIT
	PUSHJ	P,CLSS2		;5	OPEN
	PUSHJ	P,CLSS3		;6	CLS WAIT
	PUSHJ	P,CLSS4		;7	CLS RFNM WAIT
	JRST	CLSSE3		;8	ICP RFNM WAIT
	TABERR	CLSSD,<JRST	CLSSE3>



;ERRORS THAT CAUSE CLOSE TO BE SENT
CLSSE1:	AOSA	BADSTT		;BAD STATE
CLSSE2:	AOS	BADDDB		;SOCKET NOT FOUND

;SUBROUTINE TO SEND A "CLS"
CLSSS:	PUSHJ	P,PCLS		;SEND THE "CLS"
	PJRST	OUTXX		;TRANSMIT AND RETURN
;HERE IF NOT A COMPLETE MATCH
CLSS1:	JUMPE	F,[CAIG	P2,ICPMAX	;IF NO MATCH, THEN EITHER
		 JRST	MESIN		;  WE REUSED THE DDB (AT ICPRMC)
		 JRST	CLSSE4]		;  OR SOMEONE'S CONFUSED!
	CAIE	T1,.ISRCN	;RFC IN STATE?
	JRST	CLSSE3		;NO, FORGET IT
	PUSHJ	P,GETREQ	;GET REQUEST FIELD
	came	p1,.rqhst(t1)	;[96bit] does the host number match?
	JRST	CLSSE4		;NO
	camn	p3,.rqsoc(t1)	;[96bit] does the socket number match?
	PUSHJ	P,CLSS6		;YES, CHANGE TO RFC ABORT STATE
	JRST	MESIN

;HERE IF SOCKET IS OPEN
CLSS2:	TRNE	P2,1		;OUTPUT?
	JRST	CLSS2A		;YES
	MOVSI	T1,IDATWT	;INPUT
	TDNE	T1,IMPIOS(F)	;WAITING?
	PUSHJ	P,IMPWAK##	;YES
	SKIPE	IBFTHS(F)	;ANY INPUT DATA?
	SKIPGE	TTYLIN(F)	;YES, BUT DON'T LEAVE TELNET SOCKETS IN
				;  CLOSED-WITH-DATA STATE
	JRST	CLSS4		;NO. CLOSE IT.
	PUSHJ	P,NCPIOD	;YES, WAKE JOB
	MOVEI	T1,.ISCLD	;SPECIAL INPUT CLOSED WITH DATA STATE
	JRST	CLSS5		;CLOSE IT OUT

;HERE FOR OUTPUT SIDE
CLSS2A:	MOVSI	T1,OBITWT!ORFMWT ;USER WAITING?
	TDNE	T1,IMPIOS(F)
	PUSHJ	P,IMPWAK##	;YES
	MOVEI	T1,ORFNMW
	TDNE	T1,OSTAT(F) 	;RFNM OUT?
	JRST	CLSS7		;YES
	JRST	CLSS4		;NO
;HERE TO JUST FLAG THE SOCKET AS CLOSED
CLSDNO:	SKIPA	T1,[OBITWT!ORFNMW,,0];CHECK FOR OUTPUT IW STATE
CLSDNI:	MOVSI	T1,IDATWT	;OR INPUT WAIT
	TDNE	T1,IMPIOS(F)	;IS JOB WAITING FOR DATA?
	PUSHJ	P,IMPWAK##	;YES, GO POKE IT BEFORE WE CLOSE
CLSS3:	PUSHJ	P,NCPIOD	;SET DONE
	MOVEI	T1,.ISCLS
	PJRST	SETSTT		;SET NEW STATE

;HERE TO ENTER ABORT STATE
CLSS6:	PUSHJ	P,NCPIOD	;WAKE JOB
	MOVEI	T1,.ISABT	;ABORT STATE CODE
	JRST	CLSS5

;HERE TO CLOSE AN OPEN SOCKET WITHOUT WAKING THE JOB
CLSS8:	MOVEI	T1,.ISCLW	;ENTER CLOSE WAIT STATE
	JRST	CLSS5		;SET IT AND SEND CLOSE MESSAGE

;HERE TO CLOSE THE SOCKET AND SET IO DONE
CLSS4:	PUSHJ	P,NCPIOD	;WAKE JOB
	MOVEI	T1,.ISCLS	;CLOSED STATE
CLSS5:	PUSHJ	P,SETSTT	;SET NEW STATE
	PJRST	CLSSS		;SEND ANSWERING CLOSE

;HERE IF WAITING FOR RFNM
CLSS7:	MOVEI	T1,.ISRMW	;YES.  RFNM WAIT STATE.
	DPB	T1,POSTAT
	POPJ	P,
COMMENT \

UPON RECEIPT OF AN "ALL" BLOCK TYPE, THE FOLLOWING IS DONE:

1.	A SOURCE IS FORMED(HOST + LINK) AND THE DDBS SEARCHED
	FOR A MATCH IN THE OUTPUT LEADER FIELD.
2.	IF A DDB IS NOT FOUND, THE REST OF THE BLOCK IS FLUSHED
	AND IGNORED(ERROR BLOCK?).
3.	IF THE OUTPUT STATE IS NOT "OPEN"(5), THE MESSAGE IS
	IGNORED AS IN (1.).
4.	IF ALL OK, THE MESSAGES FIELD IS ADDED TO THE MESSAGE ALLOCATION
	AND THE BITS FIELD IS ADDED TO THE OUTPUT BIT
	ALLOCATION AND THE JOB WAKENED IF NECESSARY.
\

ALLS:	jumpl	p2,flsh56	;[96bit] flush if reset out
	PUSHJ	P,INXH8		;GET LINK NUMBER
	hrlz	P2,T1		;[96bit] SAVE IT
	PUSHJ	P,INXH16	;MESSAGE COUNT
	hrr	p2,t1		;[96bit] SAVE IT
	PUSHJ	P,INXH32	;BIT COUNT
	MOVEM	T1,P3		;SAVE IT
	PUSHJ	P,LNKOSR	;FIND MATCH TO LEADER
	  JRST	ALLS5		;NOT THERE OR BAD LINK.
	LDB	T1,POSTAT
	CAIE	T1,.ISOPN	;SOCKET OPEN?
	JRST	ALLS6		;NO
	MOVE	T1,P3		;RETRIEVE BIT COUNT
	ADD	T1,OALBIT(F)
	TLNE	T1,(-1←↑D32)	;OK?
	HRLOI	T1,(<1←↑D32-1>&<-1B17>) ;NO, SET TO MAX
	MOVEM	T1,OALBIT(F)	;YES
	hrrz	T1,P2		;[96bit] RETRIEVE MESSAGE COUNT
	ADD	T1,OALMES(F)
	CAILE	T1,1←↑D16-1	;OK?
	MOVEI	T1,1←↑D16-1
	MOVEM	T1,OALMES(F)	;YES
	MOVE	P3,OSKRMT(F)	;HIS SOCKET
	MOVE	P2,OSKLCL(F)	;MY SOCKET
	CAIG	P2,ICPMAX	;YES, ICP?
	JRST	ALLS3		;YES.  TAKE CARE OF IT
ALLS2:	PUSHJ	P,IMPALL##	;NO,  TELL IMP SERVICE
	JRST	MESIN

;HERE IF ICP SOCKET
ALLS3:	PUSHJ	P,ICPALL	;CALL ICP ROUTINE
	JRST	MESIN

;HERE IF CANT FIND DDB OR IF SOCKET NOT OPEN
ALLS5:	AOSA	BADDDB

;HERE IF SOCKET NOT OPEN
ALLS6:	AOS	BADSTT

;HERE TO DISCARD THE ALLOCATION
ALLS7:	MOVEM	P1,ALLDAT	;SAVE TRACKS
	JRST	MESIN		;NEXT NCP MESSAGE


;HERE ON RECEIPT OF "INR" AND "INS" MESSAGES

INRS:	PUSHJ	P,INXH8		;GET LINK NUMBER
	HRLI	p2,(T1)		;[96bit] store link where LNKOSR wants
	PUSHJ	P,LNKOSR	;SEARCH OUTPUT SOCKETS FOR MATCH
	  JRST	INSS5		;NOT FOUND
	MOVEI	S,IO.INR	;SET INR FLAG FOR USER
	PJRST	INSS1

INSS:	PUSHJ	P,INXH8		;GET LINK NUMBER
	HRLI	p2,(T1)		;[96bit] store link where LNKOSR wants
	PUSHJ	P,LNKISR	;SEARCH INPUT SOCKETS FOR MATCH
	  JRST	INSS5		;NOT FOUND
	PUSHJ	P,TTYTST##	;TELETYPE CONNECTION?
	  JRST	INSS3		;YES, WITHOUT JOB CONTROL
	  JRST	INSS4		;YES, WITH JOB CONTROL
	MOVEI	S,IO.INS	;NO, SET INS FLAG FOR USER
INSS1:	IORB	S,DEVIOS(F)
	JRST	MESIN

;HERE WHEN CAN'T FIND DDB MATCHING HOST AND LINK
INSS5:	AOS	BADDDB		;[7.01] INCREMENT ERROR COUNT
	jrst	Mesin		;[7.01] and loop

;HERE WHEN HAVE TTY CONNECTION BUT NO JOB CONTROL
INSS3:	ScnOn			; let Scnser control its intterrupts
	PUSHJ	P,TTUINS##	;HANDLE INS TO USER TELNET
	JRST	MESIN0		; reenable interrupts and back to work

;HERE WHEN HAVE TTY CONNECTION WITH JOB CONTROL
INSS4:	ScnOn			; give lock to scnser
	PUSHJ	P,TTSINS##	;HANDLE INS TO SERVER TELNET
	JRST	MESIN0		; interrupts back on and loop
;HERE ON RECEIPT OF "GVB" TYPE BLOCK
GVBS:	jumpl	p2,flsh24	;[96bit] flush if reset out
	PUSHJ	P,INXH8		;GET LINK NUMBER
	hrlz	p2,T1		;[96bit] SAVE IT
	PUSHJ	P,INXH8		;GET MESSAGE FRACTION
	hrr	p2,T1		;[96bit] SAVE
	PUSHJ	P,INXH8		;GET BIT FRACTION
	MOVE	P3,T1		;SAVE
	PUSHJ	P,LNKOSR	;FIND USER'S DDB
	  JRST	MESIN		;NOT FOUND, FLUSH
	PUSHJ	P,NDBSTI	;SETUP FOR NCP OUTPUT
	hrrz	T1,P2		;[96bit] GET BACK MESSAGE FRACTION
	MOVE	T2,OALMES(F)	;GET CURRENT MESSAGE ALLOCATION
	PUSHJ	P,GVBCLC	;CALCULATE MESSAGES TO RETURN
	EXCH	T1,P3		;SAVE, GET BIT FRACTION
	MOVE	T2,OALBIT(F)	;GET CURRENT BIT ALLOCATION
	PUSHJ	P,GVBCLC	;CALCULATE BITS TO RETURN
	MOVE	T2,P3		;GET BACK MESSAGES
	PUSHJ	P,OALDEC	;DECREMENT OUTPUT ALLOCATIONS AT THIS END
	PUSHJ	P,PRET		;BUILT A "RET" MESSAGE
	PUSHJ	P,OUTXX		;SEND IT
	JRST	MESIN


;HERE ON RECEIPT OF "RET"
RETS:	jumpl	p2,flsh56	;[96bit] flush if reset out
	PUSHJ	P,INXH8		;GET LINK NUMBER
	hrlz	p2,T1		;[96bit] SAVE IT
	PUSHJ	P,INXH16	;GET MESSAGES BEING RETURNED
	hrr	P2,T1		;[96bit] SAVE
	PUSHJ	P,INXH32	;GET BITS BEING RETURNED
	MOVE	P3,T1		;SAVE
	PUSHJ	P,LNKISR	;FIND DDB FOR LINK
	  JRST	MESIN		;NOT FOUND
	MOVE	T1,P3		;GET BITS RETURNED
	hrrz	T2,P2		;[96bit] GET MESSAGES RETURNED
	PUSHJ	P,IALDEC	;DECREMENT INPUT ALLOCATIONS
	JRST	MESIN
;ROUTINE TO COMPUTE AMOUNT OF ALLOCATION TO BE RETURNED FROM THE
;   FRACTION GIVEN IN A GVB.
;	MOVE	T1,[FRACTION (128THS OF ALLOCATION)]
;	MOVE	T2,CURRENT ALLOCATION
;	PUSHJ	P,GVBCLC
;	ALWAYS RETURN HERE--AMOUNT TO BE GIVEN BACK IN T1.

GVBCLC:	CAIL	T1,200		;OVER 127 128THS?
	MOVEI	T1,200		;YES, RETURN ALL
	MUL	T1,T2		;COMPUTE N*CURRENT ALLOCATION
	ADDI	T2,177		;ROUND UP
	TLZE	T2,400000	;OVERFLOW FROM LOW WORD?
	ADDI	T1,1		;YES, FIX
	ASHC	T1,↑D28		;DIVIDE BY 128, LEAVE IN T1
	POPJ	P,


;HERE ON ERROR MESSAGE ("ERR")
ERRS:	PUSHJ	P,INXH8		;GET ERROR CODE
	CAIG	T1,ERRMAX	;TOO BIG?
	AOS	ERRTYP(T1)	;NO.  COUNT IT
	movem	P1,ERRSHN	;[96bit] SAVE HOST NUMBER SENDING ERROR
	dpb	t1,[point 8,errshn,7]	;[96bit] SAVE ERROR CODE
	MOVEI	P2,5		;NUMBER OF 16-BIT BYTES IN DATA
	MOVE	P3,[POINT 16,ERRDAT] ;STORAGE POINTER
	PUSHJ	P,INXH16	;GET 16 BITS OF DATA FROM ERROR MSG
	IDPB	T1,P3		;STORE IN STATISTICS AREA
	SOJG	P2,.-2		;REPEAT FOR TOTAL OF 80 BITS
	JRST	MESIN		;BACK FOR NEXT MESSAGE

;HERE ON ECHO MESSAGE("ECO")
ECOS:	jumpl	p2,flsh8	;[96bit] flush if reset out
	PUSHJ	P,INXH8		;GET DATA FIELD
	HRLM	T1,p2		;[96bit] SAVE DATA
	PUSHJ	P,NDBSTI	;SET UP FOR OUTPUT
	HLRZ	T1,p2		;[96bit] GET DATA BACK
	PUSHJ	P,PERP		;BUILD A REPLY
	PUSHJ	P,OUTXX		;OUTPUT MESSAGE
	JRST	MESIN		;AND BACK FOR NEXT MESSAGE
;HERE ON ECHO REPLY TYPE MESSAGE("ERP")
ERPS:	jumpl	p2,flsh8	;[96bit] flush if reset out
	PUSHJ	P,INXH8		;GET ARGUMENT
	xor	t1,p1		;[96bit] match the two numbers
	trne	t1,377		;[96bit] any bits on that shouldn't be?
				; (were the low eight bits different?)
	  jrst	mesin		;[96bit] yes: didn't echo what we sent
	move	t1,p1		;[96bit] load the host number
	PUSHJ	P,HSTCHK	;YES, IS THE HOST THERE?
	  JRST	MESIN		;NO, FORGET IT
	TLNN	T3,HS.TST!HS.ECO; ECHO OUT?
	JRST	MESIN		;NO
	JRST	RRPS1		;YES.

;HERE ON RESET MESSAGE FROM ANOTHER HOST("RST")
RSTS:	move	T1,P1		;[96bit] GET HOST NUMBER
	PUSHJ	P,HSTCHK	;PUT HIM IN THE TABLE
	  JRST	MESIN		;NO ROOM
	PUSHJ	P,HSTRES	;RESET THIS HOST NOW
	PUSHJ	P,NDBSTI	;SET UP U, P4 FOR OUTPUT
	PUSHJ	P,PRRP		;BUILD A REPLY
	PUSHJ	P,OUTXX		;SEND IT
	JRST	MESIN

;HERE ON RESET REPLY FROM ANOTHER HOST
RRPS:	move	T1,P1		;[96bit] HOST NUMBER
	PUSHJ	P,HSTCHK	;IS THE HOST THERE?
	  JRST	MESIN		;NO
	TLNN	T3,HS.RST	;RESET OUT?
	JRST	MESIN		;NO
RRPS1:	MOVSI	T3,HS.RST+HS.ECO+HS.TST+HS.BAD+HS.TIC;CLEAR FLAGS
	andcam	t3,.htflg(t2)	;[96bit] turn off those flags
	PUSHJ	P,OUTGO1	;MAKE SURE OUTPUT GOING
	JRST	MESIN
;HERE TO GET NEXT 4 BYTES IN THE RIGHTMOST 32 BITS OF A WORD
INXH32:	MOVEI	T1,1B32		;SET FLAG BIT
	JRST	INXH		;AND GO

;HERE FOR 2 BYTES
INXH16:	MOVSI	T1,(1B16)	;SET FLAG
	JRST	INXH

;HERE TO CLEAR THE STREAM
INXHZ:	TDZA	T1,T1		;NO FLAG

;HERE TO GET NEXT BYTE
INXH8:	MOVSI	T1,(1B8)	;SET FLAG
	;FALL INTO INXH

;HERE TO GET AN ARBITRARY NUMBER OF BYTES FROM THE INPUT STREAM.
;  T1 MUST HAVE A BIT SET ON ONE OF THE BYTE BOUNDARIES.  INXH
;  WILL ASSEMBLE BYTES UNTIL THAT BIT IS SHIFTED INTO THE SIGN
;  POSITION.  IF T1 IS EMPTY, THE STREAM WILL BE INTENTIONALLY EXHAUSTED.
INXH:	PUSH	P,P1		;SAVE P1
	MOVE	P1,T1		;FLAG
INXH1:	PUSHJ	P,IMPINX##	;GET A BYTE
	  JRST	INXH3		;NONE
	JUMPE	P1,INXH1	;LOOP IF NO FLAG
	LSH	P1,8		;SHIFT ASSEMBLY REGISTER
	IORB	T1,P1		;SET BYTE INTO SHIFTER
	TLZN	T1,(1B0)	;TEST FLAG BIT
	JRST	INXH1		;AND GET MORE IF NOT SET
	POP	P,P1		;RESTORE P1
	POPJ	P,

;HERE IF INPUT DONE
INXH3:	POP	P,P1		;RESTORE P1
	POP	P,T1		;RETURN BACK A LEVEL
	JRST	MESINX
;THIS ERROR EXIT IMPLIES THAT ALL CALLS TO THE INXH- ROUTINES
;  MUST BE DONE WHEN ONLY 1 DEEP ON THE STACK.  THUS, ONLY MAIN
;  HANDLING ROUTINES(RTSS, STRS, CLSS, ETC.) CAN CALL THEM.


;VARIOUS CALLS TO ABSORB INPUT THEN LOOP BACK TO MESIN
FLSH80:	PUSHJ	P,INXH8
FLSH72:	PUSHJ	P,INXH8
FLSH64:	PUSHJ	P,INXH8
FLSH56:	PUSHJ	P,INXH8
FLSH48:	PUSHJ	P,INXH8
FLSH40:	PUSHJ	P,INXH8
FLSH32:	PUSHJ	P,INXH8
FLSH24:	PUSHJ	P,INXH8
FLSH16:	PUSHJ	P,INXH8
FLSH8:	PUSHJ	P,INXH8
	JRST	MESIN
;SUBROUTINE CALLED FROM IMP INPUT INTERRUPT LEVEL UPON
; RECEIPT OF AN RFNM.  F HAS ADDRESS OF IMP DDB.
; call:
;	ScnOff
;	pushj	p,NcpRmc
;	  <return here after ICP close dealt with>
;	<return here if more needs to be done by IMPSER
NCPRMC::LDB	T1,POSTAT	;GET STATE
	XCT	NCPRMD(T1)	;DISPATCH ON STATE
	pjrst	cpopj1##	; we don't know what to do with it.  give
				;  back to IMPSER.

;DISPATCH TABLE FOR RFNM.   INDEX WITH SOCKET STATE.
NCPRMD:	JFCL			;0
	JFCL			;1
	JFCL			;2
	JFCL			;3
	JFCL			;4
	JFCL			;5
	JFCL			;6
	JRST	RMCTDB		;7 - RFNM WAIT FOR CLOSE (skip return to user)
	JRST	ICPRMC		;8 - RFNM WAIT FOR ICP (non-skip return)
	TABERR NCPRMD


;HERE IF TIME TO CLOSE OUTPUT SIDE NOW THAT RFNM IS IN.
RMCTDB:	PUSHJ	P,SAVE4##	;SAVE SOME AC'S
	MOVE	P2,OSKLCL(F)	;SETUP OUTPUT LOCAL SOCKET NUMBER
	MOVE	P3,OSKRMT(F)	;  AND REMOTE SOCKET NUMBER
	LDB	T1,POHOST	;GET HOST NUMBER
	PUSHJ	P,NDBST2	;GET NCP DDB
	pushj	p,NcpIOD	; wkae up the job
	movei	t1,.iscls	; set the closed state
	pushj	p,SetStt	; in the DDB
	pushj	p,PCls		; send a CLS
	pushj	p,OutXX		; out it goes
	pjrst	cpopj1##	; skip return
SUBTTL	INPUT INTERRUPT		--	ICP
COMMENT \
THE INITIAL CONNECTION PROTOCOL IS IMPLEMENTED AS A SET OF SPECIAL
STATES FOR SOCKETS IN THE RANGE 0 - 255.  THEY CAUSE
THE FOLLOWING SET OF SUBROUTINE TO BE CALLED AT INTERRUPT
LEVEL:

WHEN A RTS TO SOCKET 1 - 255 IS RECEIVED, ICPRFC IS CALLED.
IF THERE ARE FACILITIES AVAILABLE, A DDB IS ALLOCATED, THE
REQUEST IS HONORED AND A SOCKET BUILT IN THAT DDB.

STRS TO SOCKETS LESS THAN 256 ARE NEVER ACCEPTED.

WHEN AN ALLOCATION MESSAGE IS RECEIVED FOR A
SOCKET IN THE RANGE 1 - 255, ICPALL IS CALLED.
A 32 BIT DATA MESSAGE IS SENT OVER
THE CONNECTION AND THE SOCKET IS PLACED IN RFNM WAIT.
THE DATA CONSISTS OF THE EVEN SERVER TELNET SOCKET TO BE USED,
WHICH IS IN THE FORM 1XXX400, WITH XXX SUCH THAT ALL SOCKETS IN
THE RANGE 1XXX400 TO 1XXX777 ARE UNUSED.

WHEN THE RFNM FOR THE DATA IS RECEIVED, ICPRMC IS CALLED.
THIS ROUTINE CLOSES THE SOCKET AND INIATES RFCS TO
THE USER SOCKET PAIR 2 GREATER THAN THAT INITIALLY
CONNECTED.
\
;HERE ON A REQUEST TO THE ICP
;CALL:
;	HRR	P1, [HOST NUMBER]
;	MOVE	P2, [LOCAL SOCKET NUMBER]
;	MOVE	P3, [REMOTE SOCKET NUMBER]
;	PUSHJ	P,ICPRFC
;	  ERROR RETURN	...  CLOSE IT
;	OK RETURN  ...	CONNECTION BEGUN
ICPRFC:
	PUSHJ	P,ICPFND	;IS THIS SOCKET'S SERVICE IMPLEMENTED?
	  POPJ	P,		;NO--TAKE ERROR RETURN
	MOVEI	J,0		;NO JOB NUMBER YET
	MOVE	T2,BUFNUM	;GET NUMBER OF FREE BUFFERS
	CAIL	T2,IMPB%4##	;ENOUGH?
	PUSHJ	P,DDBGET	;TRY FOR FREE DDB
	  POPJ	P,		;NONE LEFT
	PUSHJ	P,ITYGET##	;GET A PORT
	  PJRST	DDBREL		;NONE LEFT--RETURN THE DDB
	move	T1,P1		;[96bit] HOST NUMBER
	PUSHJ	P,SETHST	;INTO DDB
	DPB	P2,PICPSK	;REMEMBER ICP SOCKET NUMBER
	MOVEI	T1,EXTBIT	;START EXEC SOCKET TIMEOUT
	IORM	T1,IMPIOS(F)
	MOVEI	T1,ICPBYT	;USE ICP BYTE SIZE
	PUSHJ	P,PRFC		;BUILD AN RFC
	PUSHJ	P,OUTXX
	JRST	CPOPJ1##	;FINISH UP



;ROUTINE TO CHECK LEGALITY OF AN EXEC ICP
;	MOVE	P2,[LOCAL SOCKET NUMBER]
;	PUSHJ	P,ICPFND
;	  ERROR--SERVICE NOT IMPLEMENTED
;	NORMAL--T1 CONTAINS INDEX INTO SERVER TABLE (ICPSRV)

ICPFND:	MOVSI	T1,-ICPNUM	;NUMBER OF SERVICES IMPLEMENTED
ICPFN1:	LDB	T2,ICPSKT	;FETCH SOCKET NUMBER OF THIS SERVICE
	CAMN	T2,P2		;MATCH?
	JRST	CPOPJ1		;YES, GOOD RETURN
	AOBJN	T1,ICPFN1	;NO, TRY NEXT
	POPJ	P,		;ERROR--SERVICE NOT IMPLEMENTED
;HERE IF BITS ALLOCATED TO ICP SOCKET
ICPALL:	MOVEI	T1,ICPDAT	;ENOUGH BITS?
	CAMG	T1,OALBIT(F)
	SKIPG	OALMES(F)	;YES, MESSAGE ALLOWED?
	POPJ	P,		;NO.  WAIT FOR MORE (WILL COME HERE)
	PUSHJ	P,NDBSTI	;SET UP FOR OUTPUT
	PUSHJ	P,FRESKT	;FIND A FREE SOCKET NUMBER
	MOVEM	T1,ISKLCL(F)	;RESERVE IT AND REMEMBER IT FOR LATER
	EXCH	U,F		;FOOL OUTPUT ROUTINES
	PUSHJ	P,OUTX32	;BUFFER IT
	EXCH	U,F		;RESTORE
	MOVEI	T1,.ISRMI
	PUSHJ	P,SETSTT	;WAIT FOR RFNM FOR DATA
	PUSHJ	P,OUTBYT##	;LINK IT
	PJRST	OUTBFO##	;AND SEND IT
;HERE ON RFNM TO ICP SOCKET IN CLOSE RFNM WAIT
ICPRMC:	PUSHJ	P,SAVE4##	;SAVE THROUGH P4
	SETZB	T1,P4		;CLEAR LINK(AGE)
	DPB	T1,POLINK
	LDB	P1,POHOST	;GET HOST NUMBER
	DPB	P1,PIHOST	;PUT ON INPUT SIDE TOO
	PUSHJ	P,NDBSTI	;SET UP U, P4 FOR OUTPUT
	MOVE	P2,OSKLCL(F)	;MY SEND SOCKET
	MOVE	P3,OSKRMT(F)	;HIS RECEIVE SOCKET
	PUSHJ	P,PCLS		;CLOSE IT

;NOW JUST ASSUME THAT THE CLS GETS THERE INTACT(IN ORDER TO
;  AVOID TYING UP A DDB IN WAITING FOR IT), AND SET UP FOR THE
;  FINAL CONNECTIONS.
	AOS	P2,ISKLCL(F)	;GET MY OUTPUT TELNET SOCKET
	ADDI	P3,2		;ICP CONVENTION
	MOVEI	T1,NCPBYT
	PUSHJ	P,PRFC		;BUILD THE STR
	SETZM	OALMES(F)	;CLEAR OUT THE ALLOCATIONS
	SETZM	OALBIT(F)
	MOVEI	T1,EXCFLG	;MARK SOCKET AS BEING AN EXEC SERVER SOCKET
	IORM	T1,IMPIOS(F)
	LDB	T1,PICPSK	;GET ICP SOCKET NUMBER BACK
;  3 LINES REPLACED BY THE 4 BELOW TO HELP HANDLE SOCKET 27	EW/MAR 75
	CAIN	T1,3		;FTP SOCKET?
	TDZA	T1,T1		;YES - MAKE DATSET(T1) BE DATSET
	MOVEI	T1,TLNSET-DATSET ;NO - IS TELNET: CALL TO TELNET
	PUSHJ	P,DATSET(T1)	;CALL THE APPROPRIATE ROUTINE
	SUBI	P2,1
	ADDI	P3,1
	MOVEI	T1,NCPBYT
	PUSHJ	P,PRFC		;BUILD THE RTS
	MOVEI	T1,.ISRCW	;PUT THE SOCKETS INTO RFC WAIT
	DPB	T1,POSTAT
	DPB	T1,PISTAT
	PUSHJ	P,OUTXX		;TRANSMIT AND DISMISS
	popj	p,		; return
;HERE AT INTERRUPT LEVEL TO START A LOGGER TYPE PROGRAM
;  GOING TO BRING THE REMOTE USER ONTO THE SYSTEM.
ICPLOG:	MOVEI	T1,EXTMSK	;CLEAR EXEC SOCKET TIMEOUT COUNT
	ANDCAM	T1,IMPIOS(F)	;  SINCE THE CONNECTIONS ARE NOW OPEN
	MOVSI	T2,TTYKBD+TTYPTR
	LDB	P2,PICPSK	;GET ORIGINAL ICP SOCKET NUMBER
	CAIE	P2,3		;FTP USER?			EW/MAR 75
	IORM	T2,TTYLIN(F)	;NO.  SET TTY BITS
	HRLM	U,(P)		;SAVE NCP DDB ADDRESS
	HRRZ	U,TTYLIN(F)	;GET LDB ADDRESS
	PUSH	P,F		;SAVE USER DDB ADDRESS
	PUSHJ	P,TSETBI##	;CLEAR INPUT BUFFER
	PUSHJ	P,TSETBO##	;CLEAR OUTPUT BUFFER
	PUSHJ	P,ICPFND	;GET INDEX INTO SERVICE TABLE
	  STOPCD ICPLO1,DEBUG,NSF, ;++NO SERVICE FOUND
	HRRO	T2,ICPSRV(T1)	;FETCH POINTER TO LOGICAL NAME
	POP	T2,DEVLOG(F)	;SET LOGICAL NAME INTO DDB
	LDB	T1,ICPTFC	;FETCH TTY FORCED COMMAND INDEX
	PUSHJ	P,TTFORC##	;FORCE THE APPROPRIATE COMMAND
ICPLO1:	POP	P,F		;RESTORE USER DDB ADDRESS
	HLRZ	U,(P)		;RESTORE NCP DDB ADDRESS
	POPJ	P,
;TABLE OF DEFINED SERVICES AVAILABLE THROUGH EXEC ICP.
;   MACRO TO DEFINE A SERVICE:
;	SERVER	(SOCKET# , TTY FORCED COMMAND , LOGICAL NAME)

	SALL

DEFINE SERVER(SKT,TFC,NAME) <
	↑D<SKT>B26 + TFC## ,, [SIXBIT\NAME\]
>

ICPSRV:	SERVER	(1,TTFCXN,REJECT)	;(147) REJECT ATTEMPTS TO
					;(147) USE OLD TELNET
	SERVER	(3,TTFCXF,FTPSRV)	;FILE TRANSFER PROTOCOL SERVER
	SERVER	(23,TTFCXH,NETUSR)	;TELNET SERVER
	server	(79,ttfcxg,FngSrv)	;(241) finger service
IFN FTPATT,<
	0		;SPACE TO PATCH IN NEW SERVICES
	0
>
	ICPNUM==.-ICPSRV	;NUMBER OF DEFINED SERVICES
	XALL

ICPSKT:	POINT	9,ICPSRV(T1),8	;POINTER TO SERVICE SOCKET NUMBER
ICPTFC:	POINT	9,ICPSRV(T1),17	;POINTER TO TTY FORCED COMMAND INDEX
;SUBROUTINE TO SEARCH THE DDBS FOR SOME SORT OF MATCH
;  BETWEEN THE HOST AND SOCKETS GIVEN.  RETURN DATA BLOCK
;  ADDRESS IN F AND SOCKET STATE IN T1.;
;  SEARCHES FOR THE BEST MATCH TO THE CONTENTS OF P1(HOST),
;  P2(LOCAL SOCKET), P3(FOREIGN SOCKET).
;  TAKES THE NON-SKIP RETURN IF NOT A PERFECT MATCH.  F CLEARED
;  IF NO MATCH AT ALL.   DDB ADDRESS RETURNED IN F, STATE IN T1,
;  CODE IN T2 IF SOMETHING FOUND.  CODE INDICATES HOW GOOD THE MATCH
;  WAS.   TAKES SKIP RETURN IF THE MATCH WAS PERFECT.
;CALL:
;	PUSHJ	P,DDBFND
;	  ERROR RETURN	...  IMPERFECT MATCH.  CODE IN T2.
;	OK RETURN  ...	FULL MATCH
DDBFND:	PUSH	P,[0]		;RESULT
	PUSH	P,[IMPN]	;COUNT OF DDBS
	MOVEI	F,IMPDDB	;START AT BEGINNING
DDBFN1:	PUSHJ	P,GETSTT	;GET STATE
	JUMPE	T1,DDBFN4	;DONT TRY CLOSED SOCKETS
	PUSHJ	P,GETMYS	;TEST LOCAL SOCKET
	CAME	T1,P2
	JRST	DDBFN4		;LOSES
	PUSHJ	P,GETHST	;GET HOST
	JUMPE	T1,DDBFN2	;NO TEST IF NOT GIVEN
	came	t1,p1		;[96bit] TEST
	JRST	DDBFN4		;LOSES
	TLO	F,2		;SET GOOD HOST FLAG
DDBFN2:	PUSHJ	P,GETHSS	;GET HIS SOCKET
	JUMPE	T1,DDBFN3	;NO TEST IF NULL
	TLZ	T1,(<1←4-1>B3)	;CLEAR HIGH 4 BITS
	CAME	T1,P3		;TEST
	JRST	DDBFN4		;LOSES
	TLO	F,1		;FLAG HIS SOCKET GOOD
DDBFN3:	CAMLE	F,-1(P)		;THIS ONE BETTER THAN LAST?
	MOVEM	F,-1(P)		;YES, REMEMBER IT
DDBFN4:	HLRZ	F,DEVSER(F)	;GET NEXT DDB
	SOSLE	(P)		;COUNT DDBS
	JRST	DDBFN1		;LOOP
	POP	P,T1		;CLEAR OFF COUNTER
	POP	P,F		;GET RESULT
	JUMPE	F,CPOPJ##	;ERROR IF NOTHING
	PUSHJ	P,GETSTT	;GOT ONE.  FIRST GET STATE.
	HLRZ	T2,F		;NOW QUALITY OF MATCH
	ANDI	F,-1
	CAIN	T2,3		;PERFECT?
	AOS	(P)		;YES
	POPJ	P,
	SUBTTL HOST CONTROL AND QUEUEING

;FLAGS (LEFT HALF)

HS.NRM==1B18		;NOT READY FOR NEXT MESSAGE
HS.NRX==1B19		;RFNM TIMEOUT FLAG
HS.ERR==1B20		;TRANSMISSION ERROR
HS.TIC==1B21		;HOST CHECK TIMING
HS.RST==1B22		;A HOST RESET/RESET-REPLY SEQUENCE HAS BEEN
			;   INITIATED.
HS.ECO==1B23		;AN ECO IS OUT -- AN ERP IS EXPECTED
HS.BAD==1B24		;HOST IS NON-FUNCTIONAL
HS.XMT==1B25		;A TRANSMISSION IS IN PROGRESS FOR THIS
			; HOST.  FLAG SET AT INTERRUPT LEVEL WHEN OUTPUT
			;  IS STARTED,  CLEARED AT INTERRUPT LEVEL WHEN
			;  THE OUTPUT IS DONE.
HS.OK==1B26		;THIS HOST IS OK.  EITHER THIS FLAG OR HS.BAD
			;  OR BOTH MUST BE ON AT ALL TIMES
HS.TS1==1B28		;TEST BITS 1 AND 2 ARE INTERPRETED AS FOLLOWS:
HS.TS2==1B29		;	 TS1:	 TS2:	MEANING:
			;	  0	  0	NO TESTS ARE IN PROGRESS
			;	  0	  1	A TEST IS BEING QUEUED.
			;	  1	  0	A TEST IS WAITING TO BE OUTPUT.
			;	  1	  1	A REPLY IS AWAITED FROM A TEST
			;  IN CASE 1(TS1=0,TS2=1), THE MESSAGE IS TO
			;  BE PLACED AT THE BEGINNING OF THE QUEUE.
			;  IN CASE 2(TS1=1,TS2=0), THE MESSAGE WILL BE
			;  TRANSMITTED DESPITE A "BAD HOST" FLAG.
HS.TST==HS.TS1!HS.TS2	;BOTH TEST BITS

;[96bit] flags: right half has host inactivity counter field.
hs.act==7		;[96bit] maximum
;HOST TABLE:

;ENTRY FORMAT:		;[96bit]

; EACH ENTRY CONSISTS OF three WORDS:   THE FIRST WORD CONTAINS THE
; host number, right justified.  The second word contains
; FLAGS as defined above.  IT IS NEVER 0 IF THERE
; IS A HOST IN THAT SLOT.   THE SECOND WORD CONTAINS THE ADDRESSES
; OF THE LAST AND FIRST BUFFERS IN ITS OUTPUT QUEUE, IN THE LEFT
; AND RIGHT HALVES, RESPECTIVELY.  THIS WORD IS ZERO IF
; THERE IS NO OUTPUT FOR THE HOST.

;END OF TABLE:		;[96bit]

; a host word (.hthst) of -1 is used to indicate a clerical entry.
; clerical entries have two forms, depending on the value of the
; flag word (.htflg): if the flag word is greater than 0, it is a
; pointer to another buffer where the list continues.  if it is
; negative or zero, it is the end of the list, and the flag word
; contains the negative number of empty entry slots in the current
; buffer.

; the offsets for an entry in the host table are defined in
; S.mac.  they are of the form ".ht???".
SUBTTL HOST CONTROL AND QUEUEING SUBROUTINES

;SUBROUTINE TO SEARCH THE HOST LIST FOR A QUEUE FROM WHICH TO
; TRANSMIT A MESSAGE.
;CALL:
;	PUSHJ	P,NCPEOM
;	  ERROR RETURN	...ALL QUEUES EMPTY
;	NORMAL RETURN...	ADDRESS OF QUEUE POINTER IN T1
NCPEOM::SKIPG	T2,HSTLAS	;GET THE LAST HOST NUMBER CHECKED
EOM03:	MOVEI	T2,HOSTS-.htsiz	;[96bit] TOP OF LIST
EOM05:	PUSHJ	P,HSTNXT	; GET NEXT (flags loaded into T3)
	  JRST	EOM03		;END OF LIST
	SKIPE	.htbuf(T2)	;[96bit] ANY DATA?
	TLNE	T3,HS.NRM	;READY FOR MESSAGE?
	JRST	EOM02		;NO
	TLNE	T3,HS.TS1	;TEST MESSAGE TO GO?
	TLNE	T3,HS.TS2	;   (HS.TST=2)
	JRST	EOM01		;NO
	MOVSI	T3,HS.TS2+HS.XMT+HS.NRM
	JRST	EOM04		;YES.   SET RIGHT FLAGS

;HERE IF DATA TO GO
EOM01:	TLNE	T3,HS.BAD	;PROBLEM?
	JRST	EOM02		;YES.  LET CLOCK STUFF HANDLE IT.
	MOVSI	T3,HS.XMT+HS.NRM;SET FLAGS

;HERE TO SET TRANSMISSION FLAGS IN T3 AND  RETURN QUEUE ADDRESS TO
;   TRANSMITTER.
EOM04:	IORM	T3,.htflg(T2)	;[96bit] SET FLAGS
	HRRZM	T2,HSTLAS	;READY TO GO
	MOVEI	T1,.htbuf(T2)	;[96bit] QUEUE ADDRESS
	JRST	CPOPJ1##	;SKIP RETURN

;HERE IF THIS ENTRY CANT BE USED
EOM02:	CAMN	T2,HSTLAS	;MORE TO GO?
	POPJ	P,		;NO, NOTHING READY.
	SKIPG	HSTLAS		;YES.  WAS LAST HOST GIVEN?
	MOVEM	T2,HSTLAS	;NO, INITIALIZE
	JRST	EOM05		;AND LOOP
;SUBROUTINE CALLED WHEN AN NCP MESSAGE HAS BEEN TRANSMITTED
; AT INTERRUPT LEVEL.
;CALL:
;	MOVE	T1, [ADDRESS OF NEXT BUFFER(0 IF EXHAUSTED QUEUE)]
;	MOVE	T2, [ADDRESS OF third WORD OF ENTRY(QUEUE POINTER)]
;	PUSHJ	P,NCPOND
;	ALWAYS RETURN HERE
NCPOND::SKIPN	T1		;SKIP IF NOT EMPTY QUEUE
	SETZM	(T2)		;CLEAR QUEUE POINTER
	MOVSI	T1,HS.XMT	;CLEAR TRANSMISSION FLAG
	ANDCAM	T1,-1(T2)
	POPJ	P,

;SUBROUTINE TO ALLOW TRANSMISSION TO A HOST(PREVIOUS MESSAGE TO
; THE HOST WAS ACKNOWLEDGED)
;CALL:
;	MOVE	T1,HOST NUMBER
;	ScnOff
;	PUSHJ	P,NCPACK
;	ALWAYS RETURN HERE
NCPACK::PUSHJ	P,HSTCHK	;IN THE TABLE?
	  POPJ	P,		;NO.  FORGET IT.
	MOVSI	T3,HS.NRM!HS.NRX
	TDNN	T3,.htflg(t2)	;[96bit] EXPECTING RFNM?
	AOS	EXRFNM		;NO, COUNT IT.
	ANDCAB	T3,.htflg(t2)	;[96bit] CLEAR FLAGS
	PJRST	OUTGO1##	;WAKE OUTPUT
;SUBROUTINE TO INITIALIZE THE HOST TABLE.
;CALL:
;	PUSHJ	P,HSTINI
;	ALWAYS RETURNS HERE

NCPINI::
HSTINI:	MOVEI	T1,1		;INITIALIZE HOST COUNT
	MOVEM	T1,HSTCNT
	move	t1,MySite##	;[96bit] put our site in the table
	MOVEM	T1,HOSTS+.hthst	;[96bit]  AS THE ONLY ENTRY
	movei	t1,hs.ok	;[96bit] and flag as ok
	hrlzm	t1,hosts+.htflg	;[96bit] ...
	setom	hosts+.htsiz	;[96bit] set end-of-table flag
	POPJ	P,


;SUBROUTINE TO FLAG A HOST AS GOOD.  CALLED EVERY TIME A LEGAL
; MESSAGE COMES IN FROM THIS HOST.
;CALL:
;	MOVE	T1, [HOST NUMBER]
;	ScnOff
;	PUSHJ	P,HOSTOK
;	  ERROR RETURN	...  RESET IN PROGRESS
;	OK RETURN  ...	ADDRESS IN T2, FLAGS IN T3
HOSTOK:	PUSHJ	P,HSTNEW	;ENSURE HE'S IN THE TABLE
	  POPJ	P,		;[96bit] no room to put him in the table
	MOVSI	T3,HS.OK	;ASSUME HE'S OK
	IORB	T3,.htflg(T2)
	TLNE	T3,HS.RST	;RESET OUT?
	POPJ	P,		;YES.  WAIT FOR IT.
	TLZ	T3,HS.TIC!HS.BAD!HS.TST ;NO, ANY ACTIVITY IS GOOD
	MOVEI	T1,1		;SHIFT A BIT
	LSH	T1,(P2)		;  ACCORDING TO MESSAGE TYPE
	TRNN	T1,INACTM	;IS THIS "USEFUL" ACTIVITY?
	hrri	t3,0		;[96bit] YES, CLEAR INACTIVITY COUNTER
	MOVEM	T3,.htflg(T2)	;[96bit] STORE REVISED HOST FLAGS
	PUSHJ	P,OUTGO1##	;WAKE OUTPUT
	JRST	CPOPJ1##	;SKIP RETURN
;SUBROUTINE TO CHECK TO SEE THAT A HOST IS GOOD AND, IF SO,
; SEND THE MESSAGE.
;CALL:
;	MOVE	T1, [HOST NUMBER]
;	MOVE	U, [ADDRESS OF NCP OUTPUT DDB]
;	ScnOff
;	PUSHJ	P,HOSTGO
;	  ERROR RETURN...	SPACE PROBLEM OR HOST SICK
;	OK RETURN...	MESSAGE ON ITS WAY
HOSTGO:
IFN DEBUG,<JUMPE T1,CPOPJ##>
	PUSHJ	P,HSTNEW	;MAKE SURE IN THE TABLES
	  POPJ	P,		;NO ROOM
	TLNN	T3,HS.TS1	;IS THIS A TEST BEING QUEUED?
	TLNN	T3,HS.TS2	;   (TST = 1 ← 0)
	JRST	HOSTG0		;NO, PUT THIS AT END OF QUEUE
	MOVSI	T3,HS.TST	;ITS ALL QUEUED (TST←2)
	XORB	T3,.htflg(T2)
	SKIPN	T4,.htbuf(T2)	;[96bit] QUEUE EMPTY?
	JRST	HOSTG1		;YES
	HRL	T4,OBFFST(U)	;FIRST BUFFER ADDRESS
	HRR	T3,OBFLST(U)	;LAST BUFFER ADDRESS
	TLNE	T3,HS.XMT	;IN PROGRESS?
	JRST	HOSTG6		;YES
	HRRM	T4,(T3)		;NO, LINK EXISTING STREAM TO THE NEW ONE
	HLRM	T4,.htbuf(T2)	;[96bit] PUT IT AT THE FRONT
	JRST	HOSTG3		;AND GO

;HERE IF OUTPUT ALREADY GOING.  PUT TEST AFTER FIRST MESSAGE
;    (1 BUFFER PER MESSAGE).
HOSTG6:	HRL	T3,(T4)		;GET LINKAGE OUT OF FIRST BUFFER
	HLRM	T4,(T4)		;REPLACE WITH POINTER TO NEW STRING
	HLRM	T3,(T3)		;LINK THE REST TO THE NEW STREAM

	JRST	HOSTG2		;RESTORE TEM FLAGS AND GO
;HERE IF NO TEST TO BE QUEUED
HOSTG0:	SKIPN	T3,.htbuf(T2)	;[96bit] QUEUE GOING?

;HERE IF EMPTY QUEUE
HOSTG1:	MOVSI	T3,.htbuf(T2)	;[96bit] NO,  POINT TO TOP
	HLRZS	T3		;ADDRESS OF LAST BUFFER IN RIGHT HALF
	HRR	T4,OBFLST(U)	;END OF NEW STREAM
	HRL	T4,OBFFST(U)	;START OF NEW STREAM
	HLLZS	(T4)		;CLEAR NEW END LINKAGE
	HRLM	T4,.htbuf(T2)	;[96bit] NEW END OF STREAM
	HLRM	T4,(T3)		;LINKED
HOSTG2:	MOVE	T3,.htflg(T2)		;[96bit] GET FLAGS
HOSTG3:	AOS	(P)		;SKIP RETURN
	TLNE	T3,HS.BAD	;HOST OK?
	TLNE	T3,HS.TST	;NO,  ALREADY TESTING?
	JRST	OUTGO1##	;YES, START IT UP
	MOVSI	T3,HS.TS2	;SET UP A TEST
	IORM	T3,.htflg(T2)
	MOVSI	T3,HS.TIC!HS.TS1
	ANDCAB	T3,.htflg(T2)
	PUSH	P,P4		;SAVE P4
	move	t1,.hthst(t2)	;[96bit] get the host number
	push	p,t2		;[96bit] save the entry pointer
	PUSHJ	P,NDBSTC	;USE CLOCK DDB
	pop	p,t2		;[96bit] restore entry pointer
	TLNE	T3,HS.OK	;HEARD FROM HIM YET?
	JRST	HOSTG4		;YES
	movsi	t3,hs.rst	;[96bit] remember reset out.
	iorm	t3,.HtFlg(t2)	;[96bit] in the entry
	PUSHJ	P,PRST		;NO.  BUILD RST
	JRST	HOSTG5

;HERE TO SEND ECO
HOSTG4:	PUSHJ	P,PECO		;BUILD ECO

;HERE TO SEND THE MESSAGE AND RETURN
HOSTG5:	PUSHJ	P,OUTXX		;WILL CALL HOSTGO WITH TEST BIT SET
	POP	P,P4
	POPJ	P,
;SUBROUTINE TO CHECK A HOST FOR ACTIVITY.  TO BE CALLED ON A REGULAR
; BASIS(AT CLOCK LEVEL).  IF A HOST HAS BEEN INACTIVE FOR A PERIOD,
; ACTIVITY IS FORCED(THROUGH THE "ECO" TYPE MESSAGE) AND, IF NO
; REPLY IS FORTHCOMING, THE HOST IS FLAGGED BAD.  TESTING TAKES PLACE
; ON ALL HOSTS IN THE TABLE.
;CALL:
;	PUSHJ	P,HOSTCK
;	ALWAYS RETURN HERE
HOSTCK:	PUSHJ	P,SAVE4##	;SAVE ALL THE ACS
	ScnOff			;LOCK OUT CONFLICTS
	SKIPG	T2,LASCHK
HOSTC0:	MOVEI	T2,HOSTS-.htsiz	;[96bit] START AT TOP
	PUSHJ	P,HSTNXT	;GET NEXT HOST TO CHECK
	  JRST	HOSTC0		;END,   LOOP.
	MOVEM	T2,LASCHK	;REMEMBER WHICH WAS CHECKED
	move	t1,.hthst(t2)	;[96bit] get the host number
	JUMPE	T1,INTPJ##	;DONT TEST IF EMPTY
	TLNN	T3,HS.NRM	;RFNM OUT?
	JRST	HOSTC1		;NO
	MOVSI	T3,HS.NRX	;RFNM TIMER FLAG
	tdne	t3,.htflg(t2)	;[96bit] set now?
	JRST	HOSTC5		;YES, SIMULATE ONE
	iorb	t3,.htflg(t2)	;[96bit] no.  set it.

;HERE TO CHECK FOR HOST NCP ACTIVITY
HOSTC1:	camn	T1,MySite##	;[96bit] THIS SITE?
	JRST	INTPJ##		;YES,  DONT CHECK IT
	TLNE	T3,HS.TIC	;CLOCK FLAG STILL SET?
	JRST	HOSTC2		;YES, TEST HOST
	MOVSI	T3,HS.TIC
	IORB	T3,.htflg(T2)		;[96bit] NO, SET IT
	JRST	INTPJ##		;AND RESUME

;HERE IF NO NCP ACTIVITY OVER ONE TICK
HOSTC2:	TLNE	T3,HS.TST	;SOME KIND OF TEST?
	JRST	HOSTC3		;YES, FLAG THE HOST AS BAD
HOSTC7:	MOVSI	T3,HS.TIC!HS.TS1
	ANDCAB	T3,.htflg(T2)		;[96bit] CLEAR TIMER
	move	t1,.hthst(t2)	;[96bit] get the host number
	PUSHJ	P,HSTUSE	;DOES ANY DDB REFERENCE THIS HOST?
	  JRST	HSTNIU		;NO, SEE IF WE WANT TO PURGE IT
	hrri	t3,0		;[96bit] YES, CLEAR HOST INACTIVITY COUNTER
HSTC7A:	TLO	T3,HS.TS2	;SET "ECO" TEST FLAG
	MOVEM	T3,.htflg(T2)	;[96bit] STORE REVISED HOST FLAGS
	PUSH	P,P4		;SAVE P4
	PUSHJ	P,NDBSTC	;SET UP FOR OUTPUT
	PUSHJ	P,PECO		;SEND THE ECO
	PUSHJ	P,OUTXX		;(CALLS HOSTGO, ABOVE)
	POP	P,P4		;RESTORE P4
	JRST	HOSTC6		;WAKE TRANSMITTER

;HERE IF BAD HOST TIMEOUT
HOSTC3:	TLNE	T3,HS.BAD	;ALREADY SICK?
	JRST	HOSTC4		;YES
	MOVSI	T3,HS.BAD	;NO,  SET FLAG
	IORB	T3,.htflg(T2)
	JRST	HOSTC7		;START ANOTHER TEST

;HERE IF NO REFERENCES TO THIS HOST FROM ANY DDB.  WANT TO PURGE
;   INACTIVE HOSTS AFTER A WHILE SO AS TO STOP SENDING "ECO"S TO THEM.
HSTNIU:	aos	t3		;[96bit] INCREMENT INACTIVITY COUNTER
	trne	T3,HS.ACT	;[96bit] HAVE WE WAITED LONG ENOUGH?
	JRST	HSTC7A		;NO, KEEP SENDING ECOS

;HERE TO PURGE A HOST FROM THE HOST TABLE
HOSTC4:	PUSHJ	P,HSTCL1	;TAKE CARE OF IT
	JRST	INTPJ##

;HERE TO SIMULATE A RFNM
HOSTC5:	AOS	NORFNM		;COUNT THE ERROR
	MOVSI	T3,HS.NRM!HS.NRX
	ANDCAB	T3,.htflg(T2)	;[96bit] TURN OFF RFNM FLAGS
HOSTC6:	PUSHJ	P,OUTGO1##	;WAKE UP TRANSMISSION
	JRST	INTPJ##		;TURN ON INTERRUPTS AND RETURN
;SUBROUTINE TO FLAG A HOST AS BAD.   CALLED FROM INTERRUPT OR CLOCK
; LEVEL.
;CALL:
;	MOVE	T1, [HOST NUMBER]
;	ScnOff
;	PUSHJ	P,HOSTBD
;	ALWAYS RETURN HERE
HOSTBD::PUSHJ	P,HSTCHK	;YES,  IN TABLE?
	  POPJ	P,		;NO,  FORGET IT.
	MOVSI	T3,HS.TIC+HS.TST
	ANDCAB	T3,.htflg(T2)	;[96bit] CLEAR TIMER AND TEST BITS
	camn	t1,MySite##	;[96bit] THIS SITE?
	POPJ	P,		;YES
	JRST	HSTCL1		;WIPE HIM


;SUBROUTINE TO RESET(NOT WIPE) A HOST
HSTRES:	MOVSI	T3,HS.OK	;SET OK FLAG
	IORM	T3,.htflg(T2)
	HRLOI	T3,HS.NRM!HS.NRX!HS.XMT!HS.RST!HS.OK
	ANDB	T3,.htflg(T2)	;[96bit] CLEAR ALL BUT OUTPUT AND REPLY FLAGS
	JRST	HSTCLU		;CLEAR OUT USERS
;SUBROUTINE TO WIPE A HOST OUT OF ALL TABLES IN THE
;  NCP.  CALLED FROM HOSTBD.
;CALL:
;	MOVE	T1, [HOST NUMBER]
;	ScnOff
;	PUSHJ	P,HSTCLR
;	ALWAYS RETURN HERE
HSTCLR:	PUSHJ	P,HSTCHK	;IN TABLE?
	  POPJ	P,		;NO, FORGET IT

;HERE TO WIPE A HOST OUT OF EXISTENCE
HSTCL1:	MOVSI	T3,HS.BAD	;SET HOST BAD FLAG
	MOVEM	T3,.htflg(T2)	;[96bit] WIPE ALL ELSE
	setzm	.hthst(t2)	;[96bit] forget the host
	SOSG	HSTCNT		;DECREMENT COUNT OF HOSTS
	AOS	HSTCNT		;BUT KEEP IT POSITIVE

;HERE TO REMOVE ALL USER REFERENCES TO A HOST AND
;  ABORT ALL PENDING MESSAGES TO THAT HOST.
HSTCLU:	PUSHJ	P,SAVE2##	;SAVE ACS
	move	P1,T1		;[96bit] HOST NUMBER
	PUSH	P,F		;SAVE DDB ADDRESS
	MOVEI	T1,.htbuf(T2)	;[96bit] GET ADDRESS OF BUFFER HEADER
	PUSHJ	P,OUTCHK##	;AND SEE IF IT'S BUSY OUTPUTING NOW
	  JRST	HSTCL3		;YES, CAN'T DELETE MESSAGES SINCE IMPSER WANTS TO
	MOVEI	T1,0		;CLEAR BUFFERS USED
	EXCH	T1,.htbuf(T2)
	PUSHJ	P,RELBUF##	;RELEASE THE STRING OF BUFFERS
HSTCL3:	PUSH	P,[IMPN]	;COUNT OF THE DDBS
	MOVEI	F,IMPDDB##	;FOR LOSING USERS
HSTCL4:
	LDB	T3,POHOST
	came	t3,p1		;[96bit] THIS HOST?
	JRST	HSTCL5
	hrlo	p2,f		;[96bit] save F in P2, and make P2
				; odd so NCPIOD (called from
				; CLSDNO) will know to close output
	PUSHJ	P,CLSDNO	;CLOSE IT
	hlrz	f,p2		;[96bit] restore F
HSTCL5:	LDB	T3,PIHOST
	came	t3,p1		;[96bit] SAME INPUT HOST?
	JRST	HSTCL6		;NO
	hrlz	p2,f		;[96bit] save F in P2, and make P2
				; even so NCPIOD (called from CLSDNI)
				; will know to close input.
	PUSHJ	P,CLSDNI	;CLOSE IT
	hlrz	f,p2		;[96bit] restore F
HSTCL6:	HLRZ	F,DEVSER(F)	;GET NEXT DDB IN CHAIN
	SOSLE	(P)		;COUNT THE DDBS DONE
	JRST	HSTCL4		;LOOP FOR ANOTHER
	POP	P,F		;CLEAR COUNTER OFF STACK
	POP	P,F		;RESTORE DDB ADDRESS
	POPJ	P,
;SUBROUTINE TO ENTER A HOST IN THE TABLE.
;CALL:
; 	move	T1, [HOST NUMBER]
;	ScnOff
;	PUSHJ	P,HSTNEW
;	  ERROR RETURN	...NO SPACE
;	OK RETURN...	T2 HAS ADDRESS OF NEW ENTRY
HSTNEW:	PUSHJ	P,HSTCHK	;ALREADY THERE?
	  JRST	HSTNE0		;NO
	JRST	CPOPJ1##	;SKIP RETURN

;HERE IF HOST NOT YET IN TABLE.
HSTNE0:	push	p,t1		;[96bit] SAVE HOST NUMBER
	MOVEI	T1,0
	PUSHJ	P,HSTCHK	;FIND EMPTY SLOT
	  JRST	HSTNE1		;NONE
	JRST	HSTNE3		;GOT ONE

;HERE WHEN BUFFER FULL, GET MORE CORE
HSTNE4:	PUSH	P,T2		;END OF BUFFER ADDRESS
	PUSHJ	P,HBFGET##	;GET A BUFFER
	  JRST	HSTNE5		;NONE!
	POP	P,T3		;LINK TO LAST ONE
	movem	t1,.htflg(t3)	;[96bit] link up to last buffer
	movni	t3,.htepb##-1	;[96bit] get the entries per buffer.
	move	t2,t1		;[96bit] shuffle acs

;[96bit] HERE TO EXTEND THE TABLE.  t3 has the contents of the .htflg
;[96bit] word of the end of table entry.
HSTNE1:	AOJG	T3,HSTNE4	;JUMP IF NO ROOM LEFT
	setom	.htsiz+.hthst(t2)	;[96bit] advance end of tables
	movem	T3,.htsiz+.htflg(T2)	;[96bit] NEW FREE ENTRY COUNT
HSTNE3:	pop	p,t1		;[96bit] RESTORE HOST NUMBER
	movem	t1,.hthst(t2)	;[96bit] store in table
	setzb	t3,.htbuf(t2)	;[96bit] no buffers
	camn	t1,MySite##	;[96bit] THIS SITE?
	TLOA	t3,HS.OK	;[96bit] YES, FLAG OK
	HRLI	t3,HS.BAD	;[96bit] NO, FLAG BAD UNTIL KNOW BETTER
	MOVEM	t3,.htflg(T2)	;[96bit] flags
	AOS	HSTCNT		;BUMP HOST COUNT
	JRST	CPOPJ1##

;HERE IF NO ROOM FOR NEW HOST ENTRY
HSTNE5:	POP	P,T2
	jrst	tpopj##		;[96bit] restore T1 and return
;SUBROUTINE TO ENSURE THAT A HOST IS IN THE TABLES
;CALL:
; 	move	T1, [HOST NUMBER]
;	ScnOff
;	PUSHJ	P,HSTCHK
;	  ERROR RETURN	...HOST NOT THERE.  T2 POINTS AT FREE SLOT.
;	OK RETURN...	T2 HAS ENTRY ADDRESS, TEM HAS FLAGS. INTERRUPTS OFF
HSTCHK:	MOVEI	T2,HOSTS-.htsiz	;[96bit] START AT TOP
HSTCK1:	PUSHJ	P,HSTNXT	;GET NEXT ENTRY
	  POPJ	P,		;NO NEXT ENTRY...EMPTY
	came	t1,.hthst(t2)	;[96bit] is it this host?
	JRST	HSTCK1		;NO
	JRST	CPOPJ1##	;GOOD RETURN

;SUBROUTINE WHICH, GIVEN THE LAST HOST REFERENCED, RETURNS THE
; NEXT.
;CALL:
;	MOVE	T2,ADDRESS OF LAST ENTRY USED
;	PUSHJ	P,HSTNXT
;	  ERROR RETURN	...END OF LIST
;	OK RETURN...	T2 HAS ADDRESS OF NEXT ENTRY
HSTNXT:
IFN DEBUG,<JUMPN T2,HSTNX0
	STOPCD	.+1,DEBUG,ZHE,	;++ZERO HOST ENTRY
	MOVEI	T2,HOSTS-.htsiz>
HSTNX0:	ADDI	T2,.htsiz	;[96bit] BUMP THE POINTER
HSTNX1:	move	t3,.htflg(t2)	;[96bit] get flag word
	skipl	.hthst(T2)	;[96bit] is the host word negative?
	JRST	CPOPJ1##	;[96bit] no: this is a real entry
	JUMPLE	T3,CPOPJ##	;JUMP IF END OF LIST
	MOVE	T2,T3		;LINK TO NEXT BUFFERFUL
	JRST	HSTNX1
;SUBROUTINE TO DETERMINE WHETHER ANY IMP DDB REFERENCES A GIVEN HOST.
;	MOVE	T1,[HOST NUMBER]
;	PUSHJ	P,HSTUSE
;	  HOST NOT REFERENCED BY ANYBODY
;	HOST REFERENCED BY AT LEAST 1 DDB
;NO AC'S CLOBBERED

HSTUSE:	PUSHJ	P,SAVE3##	;SAVE P1-P3
	PUSH	P,F		;SAVE DDB POINTER
	MOVEI	F,IMPDDB##	;START SEARCH OF ALL DDB'S
	MOVEI	P1,IMPN##	;NUMBER OF DDBS
HSTUS1:	LDB	P2,PIHOST	;GET HOST FOR INPUT SOCKET
	LDB	P3,POHOST	;GET HOST FOR OUTPUT SOCKET
	HLRZ	F,DEVSER(F)	;ADVANCE TO NEXT DDB
	came	p2,t1		;[96bit] HOST REFERENCED BY THE DDB?
	camn	p3,t1		;[96bit] ..
	AOSA	-1(P)		;YES, PRESET SKIP RETURN
	SOJG	P1,HSTUS1	;NO, CHECK NEXT DDB
	POP	P,F		;RESTORE DDB POINTER
	POPJ	P,
SUBTTL USER INTERFACE (IMPUUO)

FtOldUUO==-1	;[96bit] make 0 if you no longer want to support the
		;	 old style UUO.

COMMENT \
PROVIDES ABILITY FOR THE USER TO INITIATE IMP CONNECTIONS
UNDER PROGRAM CONTROL.

CALL:
	MOVE AC,[BYTE (8)FLAGS, (3)TIMEOUT, (7)CODE, (18)E ]
	CALL AC,[SIXBIT /IMPUUO/]
	  ERROR RETURN  --  CODE IN E+1
	OK RETURN

;NOTE THE CORRESPONDING CALLI UUO IS -5 AT HARVARD, -17 AT CMU,
; AND -4 AT AFAL SO DON'T USE IT.

FLAGS:	\
	IF.NWT==1B0	;IF SET, DON'T GO INTO IO WAIT FOR NCP ACTIVITY
	IF.PRV==1B1	;IF SET, ALLOW THE OPERATION EVEN IF THE USER
			;  DOESN'T OWN THE DEVICE (PRIVILEGED)
	IF.ALS==1B2	;IF SET, LOCAL SOCKET IS ABSOLUTE RATHER THAN
			;  JOB- OR USER-RELATIVE (PRIVILEGED)
	if.new==1b3	;[96bit] if set, this is a new format UUO, with
			;	 a separate word in the block for byte
			;	 size.

COMMENT \
TIMEOUT:3 BIT CODE(T) STARTS A TIMEOUT OF M SECONDS
		M = 4 * 2↑T
		THUS, THE USER MAY SPECIFY A TIMEOUT FROM 8 TO 512 SECONDS.
		IF T = 0, THEN THE DEFAULT IS 30 SECONDS.


FORMAT OF THE ARGUMENT LIST: (EXCEPT AS OTHERWISE NOTED)

E:	SIXBIT /LOGICAL NAME/
	EXP STATUS/ERROR CODES
	EXP SOCKET NUMBER
	exp Foreign network/host/imp number		;[96bit]
	EXP FOREIGN SOCKET NUMBER
	xwd	byte size,0				;[96bit]
\

	.UUDEV==0
	.UUSTT==1
	.UUSKT==2
	.UUHST==3
	.UURMT==4
	.uubyt==5		;[96bit]

	.UULST==5		;[96bit]
ifn FtOldUUO,<
	.uuolt==4		;[96bit] normal length of block for
				;	 old format.  (used in .IUXIS)
>

PUUTIM:	POINT 3,P1,10		;POINTER TO GET TIMEOUT FIELD
IMPUUO::PUSHJ	P,SAVE4##	;SAVE P1, P2, P3, P4
	MOVE	P1,T1		;PERMANENT COPY OF USER STUFF
	HRR	M,P1		;REL ADDRESS OF ARG BLOCK
	LDB	T3,[POINT 7,P1,17] ;GET THE FUNCTION CODE
	MOVSI	T1,-UUOLEN	;SEARCH UUO TABLE
	MOVE	P2,UUOTAB(T1)	;GET THE TABLE ENTRY
	LDB	T2,[POINT 7,P2,17];GET THE CODE
	CAME	T2,T3		;THIS IT?
	AOBJN	T1,.-3		;NO
	JUMPGE	T1,ERRILU	;JUMP IF NOT THERE
	MOVEI	T1,JP.IMP	;TEST PRIVILEGES
	PUSHJ	P,PRVBIT##	;SUPER IMP?
	  JRST	IMPUU1		;YES
	TLZ	P1,(IF.PRV)	;NO--DISABLE PRIVILEGED IMPUUO FLAGS
	TLNE	P2,UU.PVI	;REQUIRED?
	JRST	ERRPRV		;YES--ERROR
	MOVEI	T1,JP.NET	;SETUP TO TEST NETWORK ACCESS PRIVILEGES
	TLNE	P2,UU.PVN	;NET PRIVILEGES REQUIRED?
	PUSHJ	P,PRVBIT##	;YES, GOT THEM?
	  JRST	IMPUU1		;YES OR NOT NEEDED
	JRST	ERRPRV		;NO

;HERE TO GO AHEAD WITH THE UUO DISPATCH
IMPUU1:	HRRZ	T1,P1		;ADDRESS CHECK THE ARGUMENTS
	CAIGE	T1,↑D16-.UULST	;IN ACS?
	JRST	ImpUU2		;YES, OK.
	PUSHJ	P,IADRCK##
	  JRST	ERRADR		;ADDRESS CHECK
	MOVEI	T1,.UULST(P1)
	PUSHJ	P,IADRCK##
	  JRST	ERRADR
ImpUU2:	MOVEM	W,W.SAVE	;SAVE W (UUOCON MIGHT WANT IT)
	MOVE	W,P2		;SAVE DISPATCH STUFF IN W
	tlnn	w,uu.NUp	;(260) must have a working network?
	  jrst	ImpUU3		;(260) no.  don't check.
	skipe	OKFlag##	;(260) is it working?
	 skipe	StopFl##	;(260) yes.  are we coming down?
	  jrst	ErrNNU		;(260) either not up or going down
ImpUU3:	TLNE	W,UU.DNU	;NEED TO SETUP DDB?
	  JRST	ImpUU4		;NO
	PUSHJ	P,SETDDB	;YES, DO IT
	  JRST	ImpUU5		;ERROR
ImpUU4:	TLNN	W,UU.INT	;INTERRUPTS ALLOWED?
	  ScnOff		;NO.  LET NOTHING INTERFERE
	PUSHJ	P,(W)		;CALL THE ROUTINE
	 skipa			; non-skip return, please.
	  aos	(p)		; pass back the good return.
	tlnn	w,uu.int	; did we shut down dangerous interrupts?
	  ScnOn			; yes.  allow them again.
ImpUU5:	MOVE	W,W.SAVE	;RESTORE W
	popj	p,		; return as set up

	$LOW
W.SAVE:	Z			;TEMPORARY HOLDING PLACE FOR W		DK/APR 75
	$HIGH
;MACRO FOR BUILDING THE DISPATCH TABLE

DEFINE U(C,DD,F)<
	ZZ==0
	IRP F,<
	ZZ==ZZ!UU.'F
	>

	.U'DD==↑D'C
	ZZ+↑D<C>  ,,  DD'S
>

;THE DEFINITIONS OF THE VARIOUS BITS AND FIELDS
UU.PVN==(1B1)		;NETWORK PRIVILEGES REQUIRED
UU.PVI==(1B2)		;SUPER IMP PRIVILEGES REQUIRED
UU.ASD==(1B3)		;MUST CONSOLE ASSIGN AN IMP DEVICE
UU.NDB==(1B4)		;ALLOWED TO GET A FREE DDB
UU.INT==(1B5)		;INTERRUPTS NEED NOT BE DISABLED
UU.DNU==(1B6)		;DDB NOT USED (DON'T CALL SETDDB BEFOREHAND)
uu.NUp==(1b7)		;(260) network must be up to perform this UUO.
;THE DISPATCH TABLE

UUOTAB:	SALL

	U 00,STAT,<>
;	U 01,CONN,<PVN,ASD,NDB>
;	U 02,CLOS,<PVN,ASD>
	U 03,CONN,<PVN,ASD,NDB,NUp>	;(260)
	U 04,CLOS,<PVN,ASD,NUp>		;(260)
	U 05,LIST,<PVN,ASD,NDB,NUp>	;(260)
	U 06,REQU,<PVN,ASD,NDB,NUp>	;(260)
	U 07,TALK,<PVN,ASD,NUp>		;(260)
;	U 08,TRAN,<PVN,ASD>
	U 09,PINT,<PVN,ASD,NUp>		;(260)
;	U 10,AINT,<PVN,ASD,NUp>		;(260)
	U 11,VERS,<INT,DNU>
	U 12,DEAS,<PVN,ASD>
	U 13,PHST,<INT,DNU>
;	U 14,CDDB,<>
;	U 15,PGVB,<PVN,ASD,NUp>		;(260)
	U 16,ITTY,<DNU>
	U 17,XPWT,<PVN,ASD,INT,NUp>	;(260)
	U 18,PESC,<INT,DNU>
	U 19,RESC,<INT,DNU>
	U 20,PPAR,<PVN,ASD>
	U 21,RPAR,<PVN,ASD>
	U 22,XSTS,<DNU,Int>	; we turn off interrupt when we want
	U 23,TRAC,<PVN,ASD>
	U 24,PIAL,<PVN,ASD>

	U 64,PNOP,<PVI,DNU,NUp>		;(260)
	U 65,RSET,<PVI,DNU,NUp>		;(260)
;	U 66,PALL,<PVI,ASD,NUp>		;(260)
;	U 69,PECO,<PVI,DNU,NUp>		;(260)
	U 70,INIS,<PVI,DNU>
	U 71,KILL,<PVI,INT,DNU>
	U 72,RAIS,<PVI,INT,DNU>
;	U 73,ERRO,<PVN,DNU>
IFN FTAIMP,<					;DK/OCT 75
;DO IMP IACCOUNTING
	U 81,IACT,<PVI,DNU>
>

	UUOLEN==.-UUOTAB
	XALL
;	ERROR CODES   --  RETURNED IN E+1 ON NON-SKIP RETURN

;HERE TO TEST FOR REMOTE HOST DOWN BEFORE DECLARING SYSTEM
;  FAILURE.
ERRCHK:	HRRI	M,.UUHST(P1)	;TEST HOST
	pushj	p,g.uuht	;[96bit] get host from block
	PUSHJ	P,HSTCHK	;IS HOST THERE?
	  JRST	ERRDWN		;NO
	JRST	ERRSTT		;YES -- SYSTEM FAILURE
	DEFINE	ERRCOD(M,C) <
	E.'M==	.-ERRLST
ERR'M:	JSP	T1,ERRXIT
>

ERRLST:
	ERRCOD ILU,		ILLEGAL(UNIMPLEMENTED) UUO
	ERRCOD NSD,		NO SUCH DEVICE
	ERRCOD DNA,		DEVICE NOT AVAILABLE
	ERRCOD LNU,		LOGICAL NAME ALREADY IN USE
	ERRCOD STT,		STATE ERROR (WRONG STATE FOR THIS FUNCTION)
	ERRCOD SOF,		SOCKET OPENING FAJ\URE(REFUSED)
	ERRCOD SYS,		SYSTEM ERROR
	ERRCOD ABT,		A RFC WAS ABORTED
	ERRCOD REQ,		THE REQUEST DOESNT MATCH YOUR RFC
	ERRCOD SKT,		SOCKET NUMBER IN USE
	ERRCOD HST,		ILLEGAL HOST NUMBER
	ERRCOD DWN,		REMOTE HOST DOWN OR NOT ON NET
	ERRCOD ADR,		ADDRESS CHECK IN CALLI ARG LIST
	ERRCOD	TIM,		TIMEOUT
	ERRCOD	PAR,		PARAMETER SPECIFICATION ERROR
	ERRCOD	NCI,		TTY NOT CONNECTED TO IMP
	ERRCOD	QUO,		QUOTE OR ESCAPE ILLEGAL OR NOT DISTINCT
	ERRCOD	PRV,		NOT PRIVILEGED TO DO OPERATION
	ErrCod	NAI,		device is not an IMP
	ErrCod	NNU,		;(260) Network Not Up

ERRXIT:	SUBI	T1,ERRLST+1
	ANDI	T1,-1		;GET RID OF LEFT HALF JUNK
	HRRI	M,.UUSTT(P1)	;PUT ERROR CODE HERE
	PUSHJ	P,PUTWRD##
	  JRST	ADRERR##
	POPJ	P,
	TRANS==	ERRILU		;ILLEGAL CODE


;SUBROUTINE TO PUT THE TEN ON THE NETWORK (PRIVILEGED)
RAISS:	TROA	T1,-1		;SET FLAG

;SUBROUTINE TO TAKE THE TEN OFF THE NETWORK SOFTLY. (PRIVILEGED)
KILLS:	MOVEI	T1,1		;SET FLAG
	HRREM	T1,IMPUP##
IFN FTAIMP,<
	JRST	IFRSTR		;INDICATE RESTART IN ACCT DATA
>
IFE FTAIMP,<
	JRST	CPOPJ1##
>


;SUBROUTINE TO RETURN THE CURRENT SOFTWARE VERSION NUMBERS
VERSS:	MOVE	T1,[VIMPSR,,VNETCN]
	PJRST	PWUPJ1		;GIVE HIM THE DATA AND SKIP RETURN


;SUBROUTINE TO WIPE EVERYTHING (PRIVILEGED)
INISS:	PUSHJ	P,DINI+IMPDSP##	;DO 400 RESTART STUFF
IFN FTAIMP,<
IFRSTR:	SETZ	T1,		;PREPARE ENTRY FOR ACCTNG
	MOVEI	T2,17		;IDNICATE RESTART
	DPB	T2,IFTCOD	;IN T1
	PUSHJ	P,IFENTR	;MAKE ENTRY
>
	JRST	CPOPJ1##
;SUBROUTINE TO RETURN EXTENDED STATUS OF AN IMP DEVICE.  MORE
;  ARGUMENTS MAY BE ADDED WITHOUT INVALIDATING EXISTING PROGRAMS.
;	MOVE	P1,[REL ADR OF ARGUMENT BLOCK]
;	PUSHJ	P,XSTSS
;	  ERROR--CODE IN T1
;	NORMAL RETURN--ARGUMENT BLOCK FILLED WITH STATUS INFO.

;BLOCK:	N		;NUMBER OF LOCATIONS THAT FOLLOW IN ARG BLOCK
			;  (0 IS SAME AS ↑O12)
;	SIXBIT	/DEV/
;	N-1 LOCATIONS FOR DATA TO BE RETURNED IN.  (IF N IS GREATER THAN
;		THE NUMBER OF WORDS PROVIDED BY THE MONITOR, THE REMAINDER
;		OF THE BLOCK WILL BE ZEROED).

;CURRENTLY-DEFINED INDICES ARE:
;	0	.XSNUM	NUMBER OF WORDS THAT FOLLOW
;	1	.XSDEV	DEVICE NAME
;	2	.XSIST	INPUT STATE (+ERROR CODES)
;	3	.XSILS	INPUT LOCAL SOCKET NUMBER
;	4	.XSIHS	HOST				;[96bit]
;	5	.XSIRS	INPUT REMOTE SOCKET NUMBER
;	6	.XSIBY	byte size,,0			;[96bit]
;	7	.XSOST	OUTPUT STATE
;	10	.XSOLS	OUTPUT LOCAL SOCKET NUMBER
;	11	.XSOHS	HOST				;[96bit]
;	12	.XSORS	OUTPUT REMOTE SOCKET NUMBER
;	13	.XSOBY	output byte size,,0		;[96bit]
;	14	.XSIBA	INPUT BIT ALLOCATION
;	15	.XSIMA	INPUT MESSAGE ALLOCATION
;	16	.XSOBA	OUTPUT BIT ALLOCATION
;	17	.XSOMA	OUTPUT MESSAGE ALLOCATION
;	20	.XSILK	INPUT LINK NUMBER
;	21	.XSOLK	OUTPUT LINK NUMBER
;	22	.XSIOS	RH I/O STATUS WORD (DEVIOS)
XSTSS:	PUSHJ	P,GETWDU##	;RETURN NUMBER OF USER ARGS
ifn FtOldUUO,<	;[96bit] don't make this longer for old format
	movei	p2,2*<.uuolt+1>	;[96bit] assume old format length
	tlne	p1,(if.new)	;[96bit] new format?
	  hrri	p2,2*<.uulst-.uuolt>(p2)  ;[96bit] adjust to new format
	caige	t1,(p2)		;[96bit] less than minimum?
	  hrrzi	t1,(p2)		;[96bit] yes: use minimum
>
ife FtOldUUO,<	;[96bit] do straight forward if not supporting old
	CAIGE	T1,2*<.UULST+1>	;WANT MORE THAN MINIMUM BLOCK?
	MOVEI	T1,2*<.UULST+1>	;NO, SUPPLY MINIMUM INFO
>
	ADDI	T1,(M)		;COMPUTE USER ADR OF LAST WORD OF BLOCK
	TRNN	T1,777760	;STILL IN AC'S?
	JRST	XSTSS0		;YES, IT'S OK
	TRNE	M,777760	;NO, ERROR IF STARTED IN AC'S
	PUSHJ	P,IADRCK##	;  OR IF WENT OUT OF BOUNDS
	  AOJA	P1,ERRADR
XSTSS0:	PUSH	P,T1		;SAVE USER ADR OF LAST WORD
	AOS	M,P1		;POINT TO DEVICE ARGUMENT
	PUSHJ	P,SETDDB	;SETUP IMP DDB
	  POPJ	P,		;CAN'T
	ScnOff			; make sure to get a consistent picture
	SETZ	P2,		;WANT INPUT SIDE FIRST
	PUSHJ	P,STATS0	;RETURN SHORT STATUS, INCL. DEVICE NAME
ifn FtOldUUO,<
	tlne	p1,(if.new)	;[96bit] new format?
>
	hrri	m,1(m)		;[96bit] don't overwrite the byte size
	MOVEI	P2,1		;NOW SWITCH TO OUTPUT SIDE
	PUSHJ	P,STATS1	;RETURN SHORT STATUS, EXCEPT DEVICE NAME
ifn FtOldUUO,<
	tlne	p1,(if.new)	;[96bit] new format?
>
	hrri	m,1(m)		;[96bit] don't overwrite byte size
	POP	P,P1		;GET BACK FINAL USER ADR

;LOOP TO PLACE EXTENDED VALUES IN USER BLOCK
XSTSS1:	CAIG	P1,(M)		;ANY MORE SPACE IN USER BLOCK?
	JRST	intpj1##	;NO, SKIP RETURN TO USER
	CAILE	P2,XSTBLN	;YES, REACHED END OF STATUS INFO?
	TDZA	T1,T1		;YES, RETURN ZERO FOR REST OF BLOCK
	XCT	XSTSTB-1(P2)	;NO, GET NEXT ITEM
	PUSHJ	P,PUTWD1##	;STORE IN NEXT CELL IN USER BLOCK
	AOJA	P2,XSTSS1	;BACK FOR MORE

;TABLE FOR FETCHING EXTENDED STATUS INFORMATION.  NOTE THAT IT MAY BE
;  APPENDED TO, BUT MAY NOT BE REARRANGED OR ENTRIES DELETED WITHOUT
;  INVALIDATING EXISTING PROGRAMS

XSTSTB:	MOVE	T1,IALBIT(F)	; .XSIBA  INPUT BIT ALLOCATION
	MOVE	T1,IALMES(F)	; .XSIMA  INPUT MESSAGE ALLOCATION
	MOVE	T1,OALBIT(F)	; .XSOBA  OUTPUT BIT ALLOCATION
	MOVE	T1,OALMES(F)	; .XSOMA  OUTPUT MESSAGE ALLOCATION
	LDB	T1,PILINK	; .XSILK  INPUT LINK NUMBER
	LDB	T1,POLINK	; .XSOLK  OUTPUT LINK NUMBER
	HRRZ	T1,DEVIOS(F)	; .XSIOS  DEVICE STATUS BITS

	XSTBLN==.-XSTSTB	;NUMBER OF EXTENDED STATUS ENTRIES
;SUBROUTINE TO RETURN THE STATUS OF A SIMPLEX CONNECTION
;  LOOKS AT IMPDEV(P1) AND LOW BIT OF IMPSKT(P1).
;CALL:
;	MOVE	P1,[REL ADDRESS OF ARGUMENT LIST
;	PUSHJ	P,STATS
;	  ERROR RETURN	...CODE IN T1
;	OK RETURN
STATS:	AOS	(P)		;PRESET SKIP RETURN

;CALLED FROM XSTSS (EXTENDED STATUS) ALSO.
STATS0:	HRRI	M,.UUDEV(P1)	;ADDRESS OF DEVICE NAME
	TLNE	P1,(IF.PRV)	;IF IMPORTANT PERSON,
	JRST	STATS9		;  GIVE HIM LOGICAL NAME
	LDB	T1,PJOBN##	;GET OWNERS JOB NUMBER
	MOVEI	T2,ASSCON
	TDNE	T2,DEVMOD(F)	;OWNED?
	CAME	T1,.CPJOB##	;BY THIS USER?
	JRST	STATS1		;NO
STATS9:	SKIPE	T1,DEVLOG(F)	;LOGICAL NAME ASSIGNED?
	PUSHJ	P,PUTWDU##	;YES, RETURN IT

;CALLED FROM XSTSS (EXTENDED STATUS) ALSO.
STATS1:	PUSHJ	P,GETSTS	;GET STATE
	TRZ	T1,BYTMSK	;CLEAR OUT BYTE SIZE
	LDB	T2,PJOBN##	;GET JOB NUMBER
	HRL	T1,T2		;PUT IN WORD
	PUSHJ	P,PUTWD1##	;RETURN IT TOO
	ANDI	T1,STTMSK	;JUST GET STATE
	JUMPN	T1,STATS2	;JUMP IF NOT CLOSED
	PUSHJ	P,GETWD1##	;GET USER SPECIFIED LOCAL SOCKET
	ANDI	T1,1		;LOW BIT
	SOJA	M,STATS3	;BACK UP AND OVERWRITE
;CONTINUE STATUS
STATS2:	PUSHJ	P,GETMYS	;MY SOCKET
STATS3:	PUSHJ	P,PUTWD1##	;RETURN THE FULL SOCKET NUMBER
	PUSHJ	P,GETSTT	;STATE
	caie	t1,.isrcn	;[96bit] rfc in?
	  jrst	stats4		;[96bit] no
	pushj	p,getreq	;[96bit] yes: get rfc pointer
	hrrz	p4,t1		;[96bit] save pointer
	trnn	p2,1		;[96bit] is this input?
	  skipa	t1,.rqbyt(p4)	;[96bit] yes: grab byte size from rfc
	pushj	p,getbyt	;[96bit] no: get the DDB byte size
	move	t2,t1		;[96bit] position byte size
	move	t1,.rqhst(p4)	;[96bit] get host number
	pushj	p,p.uuh1	;[96bit] store in user area as user
				;	 expects it
	move	t1,.rqsoc(p4)	;[96bit] get socket number
	jrst	stats5		;[96bit] rejoin non-rfc code

stats4:	pushj	p,getbyt	;[96bit] get the byte size
	move	p4,t1		;[96bit] save it
	pushj	p,gethst	;[96bit] get host number
	move	t2,p4		;[96bit] recall byte size
	pushj	p,p.uuh1	;[96bit] store in user area
	PUSHJ	P,GETHSS	;HIS SOCKET

stats5:	;[96bit] rfc and non-rfc rejoin
	TLZ	T1,(<1←4-1>B3)
	PJRST	PUTWD1##	;GIVE IT TO THE USER AND RETURN
;SUBROUTINE TO TRANSLATE BETWEEN IMPS AND CONTROLLING OR CONTROLLED TTYS.
;	MOVE	M,[REL ADR OF ARG BLOCK]
;	MOVE	P1,M
;	PUSHJ	P,ITTYS
;	  ERROR RETUR--CODE IN T1
;	OK RETURN

;THE RESULTS DEPEND ON THE CONTENTS OF THE BLOCK, AS FOLLOWS:
;	BEFORE				AFTER
;	------				-----
;BLOCK:	SIXBIT	/IMPN/		BLOCK:	SIXBIT	/IMPN/
;	0				FLAGS,,	TTY LINE #

;BLOCK:	0			BLOCK:	SIXBIT	/IMPN/
;	0,,	TTY LINE #		FLAGS,,	LINE # OF TTY CROSSPATCHED
;						TO IMPN.

;BLOCK:	0			BLOCK:	SIXBIT	/IMPN/
;	-1,,	TTY LINE #		FLAGS,,	LINE # OF TTY CONTROLLED
;						BY IMPN.

;FLAGS ARE:	BIT 0:	IMP CONTROLS TTY (I.E. TTY IS AN ITY)
;		BIT 1:	TTY PRINTER CROSSPATCHED TO IMP
;		BIT 2:	TTY KEYBOARD CROSSPATCHED TO IMP

ITTYS:	PUSHJ	P,GETWDU##	;GET FIRST ARGUMENT FROM USER
	JUMPE	T1,ITTYS1	;JUMP IF BLANK
	ScnOn			; let DDB stuff do it's stuff
				;  without these problems
	PUSHJ	P,SETDDB	;SETUP FOR DDB WORK
	  jrst	[		; error, not an IMP DDB
		ScnOff		; dispatch expects these off
		jrst	ErrNAI	; give the Not An Imp return
		]
	ScnOff			; shut down interrupts again
	JRST	ITTYS3		;OK, GO PROCESS USING THIS IMP

;HERE IF DEVICE NAME IS BLANK.  USE TTY NUMBER ARGUMENT.
ITTYS1:	PUSHJ	P,GETWD1##	;GET NEXT ARGUMENT
	MOVEI	T3,(T1)		;ISOLATE LINE NUMBER
	CAIL	T3,TTPLEN##	;LEGAL?
	JRST	ERRPAR		;NO
	HRRZ	U,LINTAB##(T1)	;YES, GET LDB POINTER FOR THAT LINE
	JUMPGE	T1,ITTYS2	;JUMP IF USER ASKING FOR CROSSPATCHED IMP
	CAIL	T3,ITYFST##	;NO, WANT CONTROLLING IMP.  IS THIS
	CAIL	T3,ITYFST##+ITYN## ;  AN ITY?
	JRST	ERRNCI		;NO
	SKIPA	F,ITYOFS##(T1)	;YES, GET ADR OF IMP CONTROLLING ITY
ITTYS2:	HRRZ	F,LDBIMP##(U)	;HERE TO GET ADR OF CROSSPATCHED IMP
	JUMPE	F,ERRNCI	;ERROR IF NO IMP CONNECTION TO TTY

	; fall into next page
;HERE WITH DESIRED IMP DDB POINTED TO BY F
ITTYS3:	MOVSI	U,TTYJOB+TTYPTR+TTYKBD ;BITS TO TEST FOR IMP CONNECTION
	TDON	U,TTYLIN(F)	;ARE ANY SET?  IF SO, SET U TO LDB
	JRST	ERRNCI		;NO--ERROR
	HRRI	M,(P1)		;RESET TO START OF USER ARGLIST
	MOVE	T1,DEVNAM(F)	;FETCH PHYSICAL IMP NAME
	PUSHJ	P,PUTWDU##	;RETURN IT
	LDB	T1,LDPLNO##	;FETCH LINE NO OF CONNECTED TTY
	HLL	T1,TTYLIN(F)	;RETURN FLAGS
	PJRST	PW1PJ1		;RETURN SECOND ARG AND SKIP
;ROUTINE TO SET DESIRED ALLOCATION FOR AN OPEN INPUT CONNECTION
;	MOVE	P1,[ADDRESS OF ARGUMENT LIST]
;	PUSHJ	P,PIALS
;	  ERROR--CODE IN T1
;	NORMAL RETURN
;  THE .IBHST AND .IBRMT WORDS SPECIFY THE MESSAGE AND BIT ALLOCATIONS
;  TO BE USED SUBSEQUENTLY ON THE CONNECTION.  NOTE THAT THESE ARE
;  RESET TO SMALL VALUES BY THE 'TALK' OPERATION, SO 'PIAL' SHOULD
;  BE EXECUTED AFTER 'TALK'

PIALS:	TRNE	P2,1		;INPUT SOCKET?
	JRST	ERRPAR		;NO, ERROR
	PUSHJ	P,GETWD1##	;GET DESIRED MESSAGE ALLOCATION IN .IBHST
	CAIGE	T1,1		;AT LEAST 1?
	MOVEI	T1,1		;NO, MAKE IT 1
	CAILE	T1,.ALMSX	;WITHIN LIMIT?
	MOVEI	T1,.ALMSX	;NO, USE LIMIT
	DPB	T1,PIALMS	;STORE DESIRED ALLOCATION
	PUSHJ	P,GETWD1##	;NOW GET BIT ALLOCATION IN .IBRMT
	LDB	T2,PIBYTE	;GET CONNECTION BYTESIZE
	CAIGE	T1,(T2)		;AT LEAST ONE BYTE'S WORTH?
	MOVEI	T1,(T2)		;NO, MAKE IT SO
	CAILE	T1,.ALBTX	;WITHIN LIMIT?
	MOVEI	T1,.ALBTX	;NO, USE LIMIT
	DPB	T1,PIALBT	;STORE DESIRED BIT ALLOCATION
	JRST	CPOPJ1##	;OK RETURN
;ROUTINE TO WAIT UNTIL THE CONNECTION BETWEEN A LOCAL TTY AND
;   A CROSSPATCHED IMP IS BROKEN, EITHER BY THE ESCAPE HAVING BEEN TYPED
;   OR BY THE CONNECTION BEING CLOSED OR RESET.
;	MOVE	M,[REL ADR OF ARGUMENT BLOCK]
;	PUSHJ	P,XPTWS
;	  ERROR RETURN--CODE IN T1
;	OK RETURN AFTER WAITING FOR CROSSPATCH TO BE BROKEN

XPWTS:	MOVSI	P1,TTYXWT	;SETUP WAITING-FOR-CROSSPATCH BIT
	IORM	P1,TTYLIN(F)	;SET IN DDB
	DPB	P1,PDVTIM##	;SET TIMER TO INFINITY
	MOVE	S,DEVIOS(F)	;GET I/O STATUS
	PUSHJ	P,SETACT##	;SET IOACT SO WSYNC WILL WORK
	MOVSI	T1,TTYKBD!TTYPTR ;BITS THAT MARK TTY-IMP CROSSPATCH
	TDNE	T1,TTYLIN(F)	;IS THE IMP CROSSPATCHED?
	PUSHJ	P,WSYNC##	;YES, WAIT UNTIL CROSSPATCH BROKEN
	ANDCAM	P1,TTYLIN(F)	;CLEAR WAITING-FOR-CROSSPATCH BIT
	PUSHJ	P,CLRACT##	;MAKE SURE IOACT IS CLEAR
	JRST	CPOPJ1		;OK RETURN


;ROUTINES TO SET AND READ THE USER-DEFINED CONNECTION PARAMETER WORD.
;   THIS WORD IS INTENDED FOR USE BY IMPCOM TO SAVE AND RESTORE ECHOING
;   CHARACTERISTICS, ETC.
;	MOVE	M,[REL ADR OF ARG BLOCK]
;	PUSHJ	P,PPARS (TO SET) OR RPARS (TO READ)
;	  ERROR--CODE IN T1
;	OK

;BLOCK:	SIXBIT	\IMPN\
;	EXP	PARAMETER WORD

PPARS:	HRRI	M,1(P1)		;GET USER PARAMETER
	PUSHJ	P,GETWDU##
	MOVEM	T1,USRPAR(F)	;STORE IN DDB
	JRST	CPOPJ1		;OK RETURN

RPARS:	HRRI	M,1(P1)		;POINT TO 2ND WORD OF PARAMETER BLOCK
	MOVE	T1,USRPAR(F)	;PICK UP PARAMETER WORD
	PJRST	PWUPJ1		;RETURN IT TO THE USER AND SKIP
;ROUTINES TO SET AND READ THE VARIOUS QUOTE AND ESCAPE CHARACTERS
;   FOR THE CONTROLLING TTY.
;	MOVE	M,[REL ADR OF ARG BLOCK]
;	PUSHJ	P,PESCS (TO SET) OR RESCS (TO READ)
;	  ERROR RETURN--CODE IN T1
;	OK RETURN

;BLOCK:	EXP	QUOTE CHARACTER
;	EXP	SHIFT CHARACTER
;	EXP	LOCAL ESCAPE CHARACTER
;	EXP	NETWORK ESCAPE CHARACTER

PESCS:	JSP	P2,ALLQUO	;DO THE FOLLOWING FOR EACH ARGUMENT
	PUSHJ	P,GETWDU##	;GET THE NEXT USER ARGUMENT
	HRRZ	T3,T1		;COPY THE CHARACTER
	PJRST	QUOCHK##	;CHECK IF LEGAL AND STORE IN LDB IF SO


RESCS:	JSP	P2,ALLQUO	;DO THE FOLLOWING FOR EACH ARGUMENT
	LDB	T1,LDPQTB##(T4)	;FETCH A QUOTE OR ESCAPE CHAR FROM THE LDB
	PJRST	PWUPJ1		;GIVE IT TO THE USER AND SKIP RETURN


;AUXILIARY ROUTINE TO CALL ANOTHER ROUTINE FOR EACH QUOTE OR ESCAPE
;   CHARACTER ARGUMENT
;	MOVE	P2,[ADDRESS OF ROUTINE TO CALL]
;	PUSHJ	P,ALLQUO
;	  ERROR RETURN--CODE IN T1
;	OK RETURN--CALL SUCCESSFULLY ITERATED OVER ALL CHARACTERS

;THE CALLEE IS PROVIDED WITH THE FOLLOWING AC'S SETUP:
;	U	THE TTY LDB ADDRESS
;	T4[RH]	THE QUOTE INDEX (INTO THE QUOTE POINTER TABLE)
;	M	UPDATED TO POINT TO NEXT USER ARGUMENT

ALLQUO:	SKIPE	U,TTYTAB##(J)	;FETCH THIS USER'S TTY DDB ADDRESS
	HRRZ	U,DDBLDB##(U)	;FOLLOW LINK TO LDB
	JUMPE	U,ERRDNA	;ERROR IF DETACHED OR NONEXISTENT
	MOVSI	T4,MNQUPT##	;SETUP -# OF QUOTE POINTERS,,0
ALLQU1:	PUSHJ	P,(P2)		;CALL GIVEN ROUTINE
	  JRST	ERRQUO		;ERROR RETURN--RETURN CODE
	AOBJP	T4,CPOPJ1	;INCREMENT INDEX.  DONE?
	AOJA	M,ALLQU1	;NO, DO ANOTHER ARGUMENT
;SUBROUTINE FOR SETTING UP A SIMPLEX CONNECTION.
;CALL:
;	MOVE	P1,[CODE,,RELATIVE ADDRESS OF ARGUMENT BLOCK]
;	MOVE	M,[REL ADDRESS OF ARGS (R) ]
;	PUSHJ	P,CONNS
;	ERROR RETURN	...CODE IN T1
;	OK RETURN
CONNS:	PUSHJ	P,MAKMYS	;MAKE SOCKET
	  JRST	ERRSKT		;ILLEGAL
	PUSHJ	P,GETSTT	;GET STATE
IFN DEBUG,<CAIG T1,.ISMAX>
	XCT	PRFCST(T1)	;DISPATCH
	JRST	ERRSTT

;RFC DISPATCH TABLE
PRFCST:	JRST	PRFCS3		;CLOSED
	JRST	PRFCS3		;LISTENING
	JRST	PRFCS1		;RFC IN
	JRST	PRFCS7		;ABORT
	JRST	CONNS0		;RFC WAIT
	TABERR PRFCST
;HERE IF RFC IN STATE
PRFCS1:	PUSHJ	P,CHKREQ	;CHECK FOR MATCH
	  JRST	ERRREQ		;NO GOOD.
	PUSHJ	P,GETREQ	;GET REQUEST FIELD
	move	t1,.rqbyt(T1)	;[96bit] get byte size or link number
	TRNN	P2,1		;MY RECEIVE SOCKET?
	JRST	PRFCS2		;YES
	DPB	T1,POLINK	;NO.  DEPOSIT LINK NUMBER
	JRST	PRFCS3		;AND CONNECT

;HERE IF INPUT SIDE
PRFCS2:	DPB	T1,PIBYTE	;DEPOSIT BYTE SIZE
	JRST	PRFCS3		;AND CONNECT

;HERE IF RFC ABORT STATE
PRFCS7:	PUSHJ	P,CHKREQ	;SAME?
	  JRST	ERRREQ		;NO.  DONT WORRY ABOUT IT
	MOVEI	T1,.ISCLS	;SET NEW STATE
	PUSHJ	P,SETSTT
	JRST	ERRABT		;ABORT ERROR
;HERE TO CONNECT
PRFCS3:
	pushj	p,g.uuh1	;[96bit] get the next word, and convert
				;	 user format to my format
	move	p3,t2		;[96bit] save byte size
	JUMPE	T1,ERRHST	;TEST HOST NUMBER
	PUSHJ	P,SETHST	;PLACE HOST IN DDB
	PUSHJ	P,NDBSTU	;SET UP FOR NCP OUTPUT
	TRNN	P2,1		;OUTPUT?
	JRST	PRFCS4		;NO.  DEFAULT NOT NEEDED.
	JUMPG	P3,PRFCS4	;BYTE SIZE ZERO?
	PUSHJ	P,GETBYT	;GET THE CURRENT BYTE SIZE
	SKIPG	P3,T1		;ANYTHING IN DDB?
	MOVEI	P3,↑D8		;NO.  DEFAULT TO 8.
PRFCS4:	MOVE	T1,P3		;BYTE SIZE
	PUSHJ	P,SETBYT	;PUT IN DDB
	PUSHJ	P,GETWD1##	;GET TARGET SOCKET
	EXCH	T1,P3		;PUT SOCKET IN P3, BYTE SIZE IN T1.
	MOVE	T2,P3		;BE SURE THAT THE SOCKETS ARE DIFFERENT
	XOR	T2,P2		;  GENDER.
	TRNN	T2,1		;  ??
	JRST	ERRPAR		;ERROR!
	PUSHJ	P,PRFC		;BUILD RFC
	TRNN	P2,1		;INPUT SOCKET?
	PUSHJ	P,DATSET	;YES, SET ALLOCATION
	PUSHJ	P,GETSTT	;GET STATE
	CAIE	T1,.ISRCN	;RFC IN?
	JRST	PRFCS5		;NO
	MOVEI	T1,.ISOPN	;YES, NOW TO OPEN
	PUSHJ	P,SETSTT
	MOVEI	T1,.ALBTS	;INITIAL ALLOCATION (BITS)
	MOVEI	T2,.ALMSS	;(MESSAGES)
	TRNN	P2,1		;BUT ONLY FOR INPUT
	PUSHJ	P,PALL
	JRST	PRFCS6		;AND SEND IT

;HERE IF NOT RFC IN STATE
PRFCS5:	MOVEI	T1,.ISRCW	;INTO RFC WAIT
	PUSHJ	P,SETSTT
PRFCS6:	PUSHJ	P,OUTXX		;SEND IT
				;FALL INTO WRAP-UP
;HERE WHEN ALL SET UP
CONNS0:	JUMPL	P1,CPOPJ1	;OK IF FLAG SET
	HRRI	M,.UUSKT(P1)	;POINT AT LOCAL SOCKET
	MOVEI	T1,.ISRCW
	PUSHJ	P,NCSYNC	;WAIT FOR SOMETHING
	CAIE	T1,.ISOPN	;IS IT OPEN?
	CAIN	T1,.ISCLD	;OR CLOSED AFTER DATA IN?
	JRST	CPOPJ1##	;YES.  OK.
	CAIN	T1,.ISCLS	;CLOSED?
	JRST	CONNS1		;YES.  DOWN OR REFUSED.
	MOVEI	T1,TIMFLG	;NO
;[CMU]  LINE REPLACED BY 3 WHICH FOLLOW
;[CMU]	TDNN	T1,IMPIOS(F)	;TIMEOUT?
	MOVE	T2,IMPIOS(F)	;[CMU] SAVE FLAGS
	ANDCAM	T1,IMPIOS(F)	;[CMU] THEN CLEAR TIMFLG
	TRNN	T2,TIMFLG	;[CMU]  AND CHECK FOR TIMEOUT...
	JRST	ERRSTT		;NO.  SYSTEM FAILURE
	JRST	ERRTIM		;YES

;HERE IF DOWN OR REFUSED
CONNS1:	pushj	p,g.uuh1	;[96bit] get host from user
	PUSHJ	P,HSTCHK	;HOST IN TABLES?
	  JRST	ERRDWN		;NO
	JRST	ERRSOF		;REFUSED
;SUBROUTINE TO DROP A CONNECTION.
;CALL:
;	PUSHJ	P,CLOSS
;	ERROR RETURN --  CODE IN T1
;	OK RETURN
CLOSS:	SKIPGE	TTYLIN(F)	;JOB CONTROL?
	TLNE	P1,(IF.PRV)	;YES, ENABLED SUPER-IMP PRIVILEGES?
	JRST	PCLSSD		;NO JOB CONTROL OR CORRECT PRIVILEGES
	PUSHJ	P,PRVJ##	;TEST FOR LOGIN, LOGOUT
	  CAIA			;OK TO SUICIDE
	JRST	ERRDNA		;NOT AVAILABLE TO CASUAL PROG.
PCLSSD:	PUSHJ	P,GETSTT	;GET STATE
IFN DEBUG,<CAIG T1,.ISMAX>
	XCT	PCLSST(T1)	;DISPATCH
	JRST	ERRSTT

;DISPATCH TABLE
PCLSST:	JRST	PCLSS5	;ALREADY CLOSED
	JRST	PCLSS5	;LISTENING
	JRST	PCLSS4	;RFC IN
	JRST	PCLSS5	;RFC ABORT
	JRST	PCLSS1	;RFC WAIT
	JRST	PCLSS0	;OPEN
	JRST	PCLSS3	;CLS WAIT
	JRST	PCLSS1	;CLS RFNM WAIT
	JRST	PCLSS1	;ICP RFNM WAIT
	JRST	PCLSS5	;CLOSED BUT DATA THERE
	TABERR PCLSST

;HERE IF SOCKET IS OPEN
PCLSS0:	TRNN	P2,1		;TRANSMIT SOCKET?
	JRST	PCLSS1		;NO
	MOVSI	S,ORFMWT!IO
	IORM	S,IMPIOS(F)
	IORB	S,DEVIOS(F) 	;SET WAIT FLAG
	MOVEI	T1,ORFNMW
	tdnn	T1,OSTAT(F) 	;RFNM OUT?
	  jrst	pclss6		; no.  don't wait, then
	PUSHJ	P,IMPW60##	;YES.  WAIT FOR IT
	ScnOff			;INTERRUPTS ENABLED IF WAITED
pclss6:	PUSHJ	P,IMPWK1##	;MAKE SURE FLAG CLEARED
	LDB	T1,POSTAT	;IN CASE HE GOT A CLS IN
	CAIE	T1,.ISOPN	;STILL OPEN?
	JRST	PCLSSD		;NO
;HERE IF WANT TO CLOSE THE SOCKET
PCLSS1:	PUSHJ	P,GETHSS	;GET HIS SOCKET
PCLSS2:	MOVE	P3,T1		;PUT IN RIGHT AC
	PUSHJ	P,GETMYS	;ENSURE RIGHT LOCAL SOCKET # USED
	MOVE	P2,T1
	PUSHJ	P,GETHST	;GET THE HOST NUMBER
	PUSHJ	P,NDBSTU	;SET UP UUO DDB FOR NCP
	PUSHJ	P,GETSTT	;GET CURRENT STATE
	CAIN	T1,.ISRMW	;CLOSE RFNM WAIT?
	TDZA	T1,T1		;YES, SET SOCKET TO CLOSED NOW
	MOVEI	T1,.ISCLW	;NO, ENTER CLS WAIT STATE
	PUSHJ	P,SETSTT
	PUSHJ	P,PCLS		;MAKE THE "CLS" MESSAGE
	PUSHJ	P,OUTXX		;SEND IT
	JRST	CLOSS1

;HERE IF CLS WAIT
PCLSS3:	JUMPL	P1,PCLSS5	;FORCE THE CLOSE IF NOT WAITING FOR COMPLETION
	JRST	CLOSS1		;OTHERWISE JUST WAIT

;HERE IF RFC IN STATE
PCLSS4:	PUSHJ	P,GETREQ	;GET REQUEST QUEUE
	MOVE	P3,T1		;SAVE THE ADDRESS
	move	t1,.rqhst(p3)	;[96bit] get host
	PUSHJ	P,SETHST	;SO PCLSS2 WILL WORK
	move	t1,.rqsoc(p3)	;[96bit] get foreign socket of request
	PUSHJ	P,SETHSS	;PUT IN NORMAL POACE FOR CLOSE
	JRST	PCLSS2		;RESUME

;HERE IF RFC ABORT OR LISTENING OR FORCING A CLOSE
PCLSS5:	MOVEI	T1,.ISCLS	;SET TO CLOSED
	PUSHJ	P,SETSTT
				;FALL INTO WRAP-UP
;HERE WHEN ALL SET UP
CLOSS1:	JUMPL	P1,CPOPJ1	;NO IO WAIT IF FLAG ON
	HRRI	M,.UUSKT(P1)	;POINT AT LOCAL SOCKET
	MOVEI	T1,.ISCLW
	PUSHJ	P,NCSYNC	;WAIT FOR ACTIVITY
	JUMPE	T1,CPOPJ1	;OK IF CLOSED
	pushj	p,g.uuh1	;[96bit] get the host again
	PUSHJ	P,HSTCHK	;IS HE THERE?
	  JRST	ERRDWN		;NO
	MOVEI	T1,TIMFLG	;YES
	TDNN	T1,IMPIOS(F)	;TIMEOUT?
	JRST	ERRSYS		;NO, CLOSE FAILURE
	JRST	ERRTIM		;YES


;SUBROUTINE TO DEASSIGN A DEVICE AFTER IT HAS HAD
;  BOTH SIDES CLOSED.
;CALL:
;	PUSHJ	P,DEASS
;	  ERROR RETURN	...CODE IN T1
;	OK RETURN...	DEVICE DEASSIGNED
DEASS:	LDB	T1,POSTAT	;OUTPUT SIDE
	JUMPN	T1,ERRSTT	;JUMP IF NOT CLOSED
	LDB	T1,PISTAT	;INPUT SIDE
	JUMPN	T1,ERRSTT	;SAME TEST
	PUSHJ	P,DDBREL	;NOW RELEASE IT
	JRST	CPOPJ1##	;SKIP RETURN
;SUBROUTINE TO PUT A SOCKET IN THE LISTENING STATE
;THE SOCKET MUST BE CLOSED, LISTENING, OR IN RFC IN STATE.
;CALL:
;	PUSHJ	P,LISTS
;	ERROR RETURN --  CODE IN T1
;	OK RETURN

LISTS:	PUSHJ	P,GETSTT	;GET STATE
	CAIN	T1,.ISRCN	;RFC IN?
	JRST	LISTS4		;YES, TEST IT
	CAIN	T1,.ISLSN	;ALREADY LISTENING?
	JRST	LISTS1		;YES.  JUST GET PARAMETERS
	JUMPN	T1,ERRSTT	;NO, BETTER BE CLOSED
	PUSHJ	P,MAKMYS	;MAKE A SOCKET
	  JRST	ERRSKT		;ILLEGAL
	PUSHJ	P,SETMYS	;PUT IT IN THE DDB
LISTS1:
	pushj	p,g.uuh1	;[96bit] get word and convert.
	move	p3,t2		;[96bit] save byte size
	PUSHJ	P,SETHST	;SET HOST NUMBER IN DDB
	MOVE	T1,P3		;GET BYTE SIZE
	PUSHJ	P,SETBYT	;SET IT
	PUSHJ	P,GETWD1##	;GET REMOTE SOCKET NUMBER
	PUSHJ	P,SETHSS	;SET IT  IN DDB
	MOVEI	T1,.ISLSN	;SET STATE TO LISTENING
	PUSHJ	P,SETSTT
	JRST	CPOPJ1##

;HERE IF RFC IN
LISTS4:	PUSHJ	P,CHKREQ	;CHECK FOR MATCH
	  JRST	ERRREQ		;DOESNT MATCH
	JRST	CPOPJ1##	;ALL OK

COMMENT \
	PERHAPS WANT TO AUTOMATICALLY REFUSE THE LOSING REQUEST
\
;SUBROUTINE TO GET A SOCKET REQUEST
;IF THERE IS NONE IN YET, THE JOB WAITS FOR ONE.
;CALL:
;	PUSHJ	P,REQUS
;	ERROR RETURN -- CODE IN T1
;	OK RETURN

REQUS:	PUSHJ	P,LISTS		;MAKE SURE LISTENING OR RFC IN
	  POPJ	P,		;ERROR!!
	JUMPL	P1,CPOPJ1	;NO WAIT IF FLAG ON
	HRRI	M,.UUSKT(P1)	;POINT AT LOCAL SOCKET
	MOVEI	T1,.ISLSN
	PUSHJ	P,NCSYNC	;WAIT FOR ACTIVITY
	CAIE	T1,.ISRCN	;RFC IN?
	JRST	REQUS1		;NO.
	PUSHJ	P,GETREQ	;GET REQUEST FIELD
	HRRZ	P3,T1		;SAVE REQUEST POINTER
	pushj	p,g.uuh1	;[96bit] get next word and convert
	move	t1,.rqhst(p3)	;[96bit] write over the host
	trnn	p2,1		;[96bit] input?
	  move	t2,.rqbyt(p3)	;[96bit] yes: also write over byte size
	pushj	p,p.uuht	;[96bit] convert to user's format
				;	 and store in user's area
	move	t1,.rqsoc(p3)	;[96bit] get socket(32 bit)
	TLZ	T1,(<1←4-1>B3)

;HERE TO STORE IN THE NEXT WORD OF THE USER'S BLOCK, THEN SKIP RETURN
PW1PJ1:	PUSHJ	P,PUTWD1##	;RETURN IT
	JRST	CPOPJ1##	;OK RETURN

REQUS1:	MOVEI	T1,TIMFLG	;RFC NOT IN AFTER WAITING
	TDNN	T1,IMPIOS(F)	;TIMEOUT?
	JRST	ERRCHK		;NO
	JRST	ERRTIM		;YES
;SUBROUTINE TO CONNECT A DUPLEX IMP CONNECTION TO
;  THE USER'S LOCAL TELETYPE.
;CALL:
;	MOVE	P1,[ADDRESS OF ARGUMENT LIST]
;	PUSHJ	P,TALKS
;	  ERROR RETURN	...CODE IN T1
;	OK RETURN...	TELETYPE CONNECTED
TALKS:	MOVEI	P2,1		;CHECK OUTPUT SOCKET FIRST
TALKS1:	PUSHJ	P,GETSTT	;GET SOCKET STATE
	CAIE	T1,.ISOPN	;OPEN?
	JRST	ERRSTT		;NO
	PUSHJ	P,GETBYT	;GET BYTE SIZE
	CAIE	T1,NCPBYT	;RIGHT SIZE FOR TELETYPES?
	JRST	ERRSTT		;NO
	SOJGE	P2,TALKS1	;NOW CHECK INPUT SOCKET TOO
	SKIPGE	TTYLIN(F)	;JOB-CONTROLLING IMP?
	JRST	ERRDNA		;YES, DON'T ALLOW, ELSE WIERD LOOP
	MOVSI	T1,(IECHO)	;SET UP FOR TWEAK
	MOVE	T2,[ANDCAM T1,TELOWD(F)];NORMALLY A CLEAR
	JUMPGE	P1,.+2		;BUT SOMETIMES NOT IF /ECHO SWITCH USED
	HRLI	T2,(IORM T1,(F));  (ASSUMING HERE FROM IMPCOM)
	XCT	T2		;DO IT
	PUSHJ	P,IMPTTY##	;SET UP THE CONNECTION
	PUSHJ	P,TLNSET	;SPECIFY SMALL ALLOCATIONS FOR TTY'S
	JRST	CPOPJ1##	;  AND RETURN


;SUBROUTINE TO ENABLE/DISABLE SENDING THE TRACE BIT ON ALL OUTPUT
;  MESSAGES THRU THIS SOCKET.
;	MOVE	P1,[ADDRESS OF USER ARGUMENT LIST]
;	PUSHJ	P,TRACS
;	  ERROR--CODE IN T1
;	OK RETURN -- TRACE ENABLED OR DISABLED

;BLOCK:	SIXBIT	/DEV/
;	EXP	SWITCH (0 TO DISABLE, NONZERO TO ENABLE)

TRACS:	TRNN	P2,1		;CAN ONLY DO THIS FOR OUTPUT CONNECTIONS
	JRST	ERRPAR		;OOP
	HRRI	M,.UUSTT(P1)	;OK, POINT TO TRACE SWITCH
	PUSHJ	P,GETWDU##	;GET IT FROM USER CORE
	JUMPE	T1,.+2		;JUMP IF TURNING OFF
	MOVEI	T1,1		;ON
	MOVSI	T2,(TRCENB)	;SET OR CLEAR TRACE ENABLE BIT IN DDB
	XCT	TRCTAB(T1)	;ANDCAM OR IORM
	JRST	CPOPJ1##	;SKIP RETURN TO USER

TRCTAB:	ANDCAM	T2,ostat(F)	;[96bit] DISABLE
	IORM	T2,ostat(F)	;[96bit] ENABLE
;SUBROUTINE TO SEND AN INTERRUPT ON THE SPECIFIED SOCKET
;CALL:
;	MOVE	P1,[ADDRESS OF ARGUMENT LIST]
;	PUSHJ	P,PINTS
;	ALWAYS RETURN HERE
PINTS:	PUSHJ	P,GETSTT	;GET THE STATE
	CAIE	T1,.ISOPN	;OPEN?
	JRST	ERRSTT		;NO
	PUSHJ	P,GETHST	;GET THE HOST NUMBER
	PUSHJ	P,NDBSTU	;SET UP NCP UUO DDB
	TRNN	P2,1		;MY RECEIVE SOCKET?
	PUSHJ	P,PINR		;YES, SEND "INR"
	TRNE	P2,1
	PUSHJ	P,PINS		;NO, SEND "INS"
	PUSHJ	P,OUTXX		;SEND IT
	JRST	CPOPJ1##	;OK RETURN

REPEAT 0,<
;SUBROUTINE TO SPECIFY THE USERS TRAP ADDRESS FOR INCOMING
;  INTERRUPTS.(NOT FULLY IMPLEMENTED)
;CALL:
;	MOVE	P1,[ADDRESS OF ARGUMENT LIST]
;	PUSHJ	P,AINTS
;	  ERROR RETURN	...CODE IN T1
;	OK RETURN...	ADDRESS DEPOSITED IN DDB
AINTS:	PUSHJ	P,GETSTT	;GET STATE
	CAIE	T1,.ISOPN	;BETTER BE OPEN
	JRST	ERRSTT		;IT ISNT
	PUSHJ	P,GETWD1##	;GET HOST NUMBER FIELD(DISPATCH ADDRESS)

	HRRZS	T1
	PUSHJ	P,SETINT	;SET IT IN THE DDB
	JRST	CPOPJ1##	;OK RETURN

;STILL IN REPEAT 0
;SUBROUTINE TO SEND A "ECO" MESSAGE AT UUO LEVEL(PRIVILEGED)
PECOS:	PUSHJ	P,GETHS1	;GET, TEST HOST NUMBER
	  JRST	ERRHST		;FOUL-UP
	PUSHJ	P,NDBSTU	;SET UP UUO DDB FOR NCP
	PUSHJ	P,PECO		;SEND IT
	PUSHJ	P,OUTXX
	JRST	CPOPJ1##
> ;END REPEAT 0

;SUBROUTINE TO RETURN THE LOCAL HOST AND IMP PARAMETERS
;	PARAMETERS:
;	    In .IbDev (.UUDev):
;		bits 1-8:	# OF ITY'S IN SYSTEM
;		bits 9-17:	# OF IMPS
;(246)		right half:	tty number of first ITY.
;	    In .IbStt (.UUStt):
;		BIT 0:	1 IF IMP IS NOT READY
;	    In .IbHst (.UUHst)
;		bits 18-35:	LOCAL HOST'S NETWORK ADDRESS
PHSTS:
ifn FtOldUUO,<	;[96bit] if we still support old style UUOs
	tlnn	p1,(if.new)	;[96bit] new or old?
	  jrst	phsts0		;[96bit] old style: go do it
>
	hrlzi	t1,itimpl##	;[96bit] get the ity/imp count
	hrri	t1,ityfst##	;(246) and the first ITY number.
	pushj	p,putwdu##	;[96bit] put in first word of block
	setz	t1,		;[96bit] (more imp status can go in
				;	  around here somewhere.)
	skipn	okflag##	;[96bit] imp up?
	  tlo	t1,400000	;[96bit] no: set flag
	pushj	p,putwd1##	;[96bit] put that in the second word
	move	t1,mysite##	;[96bit] get my site number
	hrri	m,.uuhst(p1)	;[96bit] point to host word

;HERE TO RETURN A WORD TO THE USER'S BLOCK, THEN SKIP RETURN
PWUPJ1:	PUSHJ	P,PUTWDU##	;RETURN IT
	JRST	CPOPJ1		;OK RETURN

ifn FtOldUUO,<	;[96bit] if we still support old style UUOs
phsts0:	;[96bit] process an old style UUO
	movei	t2,itimpl##	;[96bit] get the ity/imp count
	skipn	okflag##	;[96bit] imp up?
	  tro	t2,400000	;[96bit] no: set flag
	move	t1,mysite##	;[96bit] get my site number
	HRRI	M,.UUHST(P1)	;POINT TO HOST WORD IN USER ARGLIST
	pushj	p,p.uuht	;[96bit] convert it to old format
				;	 and store as user wants
	jrst	cpopj1##	;[96bit] give a skip return
>;[96bit] 	end of old UUO support

REPEAT 0,<		;THESE FUNCTIONS WERE NEVER DEBUGGED
;HERE TO SEND AN "ALL" TYPE MESSAGE(PRIVILEGED)
PALLS:	PUSHJ	P,GETSTT	;GET STATE
	CAIE	T1,.ISOPN	;OPEN?
	JRST	ERRSTT		;NO
	PUSHJ	P,GETWD1##	;GET MESSAGES
	MOVE	P3,T1
	PUSHJ	P,GETWD1##	;GET BITS
	MOVE	T2,P3
	TRNN	P2,1		;MY SEND?
	JRST	PALLS1		;NO
	ADDM	T1,OALBIT(F)
	ADDM	T2,OALMES(F)
	PUSHJ	P,IMPALL##	;TELL IMP SERVICE
	JRST	CPOPJ1##

;HERE TO SEND "ALL" TO REMOTE HOST
PALLS1:	MOVNS	T1
	ADDM	T1,IALBIT(F)	;DECREMENT INPUT ALLOCATION COUNTERS
	MOVNS	T2		;  SO THEY WILL BE INCREASED AT CLOCK
	ADDM	T2,IALMES(F)	;  OR INTERRUPT LEVEL.
	JRST	CPOPJ1##

;STILL IN REPEAT 0
;HERE TO SEND A "GVB" MESSAGE TO RE-INITIALIZE ALLOCATION.
PGVBS:	LDB	T1,PIHOST	;GET HOST NUMBER
	PUSHJ	P,NDBSTU	;SET UP AN NCP DDB
	PUSHJ	P,PGVB		;BUILD THE MESSAGE
	PUSHJ	P,OUTXX		;SEND IT
	JRST	CPOPJ1##
> ;END REPEAT 0

;ROUTINE TO RESET A SPECIFIED HOST (PRIVILEGED)
RSETS:	PUSHJ	P,GETHS1	;GET AND TEST HOST NUMBER
	  JRST	ERRHST		;NO GOOD
	PUSH	P,T1		;SAVE IT
	PUSHJ	P,HSTCLR	;WIPE THE HOST LOCALLY
	POP	P,T1		;GET BACK HOST NUMBER
	PJRST	PNOPS1		;CAUSE 'RST' TO BE SENT BY QUEUEING A NOP

;HERE TO SEND A "NO-OP" TO THE SPECIFIED HOST
PNOPS:	PUSHJ	P,GETHS1	;GET AND TEST HOST NUMBER
	  JRST	ERRHST		;ERROR
PNOPS1:	PUSHJ	P,NDBSTU	;SET UP A DDB
	PUSHJ	P,PNOP		;FORM THE MESSAGE
	PUSHJ	P,OUTXX		;SEND IT
	JRST	CPOPJ1##	;RETURN

;SUBROUTINE TO GET THE HOST FIELD  AND TEST IT.
GETHS1:
	hrri	m,.uuhst(p1)	;[96bit] set to host word
	pushj	p,g.uuht	;[96bit] get host word
	jumpg	t1,cpopj1##	;[96bit] greater than 0 is OK.
	popj	p,		;[96bit] 0 is not OK.
;SET UP A DDB FOR UUO WORK
;CALL:
;	MOVE	P1,[ XWD CODE, REL ADDRESS OF ARGUMENT LIST]
;	MOVE	M,[RELADR(R)]
;	MOVE	J,JOB NUMBER
;	PUSHJ	P,SETDDB
;	ERROR RETURN -- CODE IN T1
;	OK RETURN

SETDDB:	PUSHJ	P,GETWDU##	;GET UUO DEVICE NAME
	EXCH	W,W.SAVE		;5.07 DEVSRG REQUIRES ORIG VALUE OF W	DK/APR 75
	JUMPE	T1,SETDD1	;JUMP IF NONE
	PUSHJ	P,DEVSRG##	;FIND DEVICE
	  JRST	SETDD1		;NO SUCH DEVICE
	EXCH	W,W.SAVE		;RESTORE W TO ITS RIGHTFUL CONTENTS	DK/MAR 75
	HLRZ	T1,DEVNAM(F)	;PHYSICAL DEVICE NAME
	CAIE	T1,(SIXBIT -IMP-);AN IMP?
	JRST	SETDD2		;NO
	LDB	T1,PJOBN##	;GET OWNER'S JOB NUMBER
	CAMN	T1,J		;SAME?
	JRST	SETDD3		;YES
	TLNE	P1,(IF.PRV)	;NO, SPECIAL ACTION?
	TLOA	P1,(IF.NWT)	;YES, FORCE NOWAIT OPTION
SETDD3:	TLNN	W,UU.ASD	;MUST ASSIGN DEVICE?
	JRST	SETDD0		;NO. DON'T ASSIGN IT
	PUSHJ	P,GETWDU##	;GET DEVICE NAME FOR ASSASG		DK/MAR 75
	MOVEI	T2,ASSCON	;ASSIGN BY CONSOLE
	EXCH	W,W.SAVE		;PRESERVATION AGAIN			DK/MAR 75
	PUSHJ	P,ASSASG##
;	  JRST	ERRDNA		;CANT HAVE IT
	  JRST	SETDER		;REPLACEMENT FOR ABOVE		DK/MAR 75
	EXCH	W,W.SAVE		;					DK/MAR 75
	LDB	T1,POSTAT	;MAKE SURE ITS ALL CLOSED
	JUMPN	T1,SETDD0
	LDB	T1,PISTAT
	JUMPN	T1,SETDD0
	PUSHJ	P,CLRIMP	;CLEAR THE DDB
SETDD0:	HRRI	M,.UUSKT(P1)	;POINT AT LOCAL SOCKET NUMBER
	PUSHJ	P,GETWDU##	;GET IT
	MOVE	P2,T1		;PUT IN PROPER AC
	JRST	CPOPJ1##	;RETURN

;HERE WHEN THE DEVICE IS NOT AN IMP
SETDD2:	PUSHJ	P,GETWDU##	;GET DEVICE NAME AGAIN
	CAMN	T1,DEVLOG(F)	;WAS IT THE LOGICAL NAME FOR THIS IMP?
	JRST	ERRLNU		;YES, CAN'T ALLOW IT.

;HERE WHEN CANT FIND THE SPECIFIED DEVICE
	SKIPA			;FOR TH FALL-THROUGH		DK/MAR 75
SETDD1:	EXCH	W,W.SAVE		;RESTORE W CLOBBERED BY DEVSRG	DK/MAR 75
	TLNE	W,UU.NDB	;ALLOWED TO GET FREE DDB?
	PUSHJ	P,DDBGET	;GET A DDB
	  JRST	ERRNSD		;NO OR NONE
	PUSHJ	P,GETWDU##	;GET DEVICE NAME AGAIN
	JUMPE	T1,.+3		;SPECIFIED?
	CAME	T1,[SIXBIT\IMP\] ;AND NOT 'IMP'?
	MOVEM	T1,DEVLOG(F)	;YES, ASSIGN LOGICAL NAME
	EXCH	W,W.SAVE		;PREVENT ASSASINATIONS		DK/MAR 75
	PUSHJ	P,SETDVL##	;MARK DDB AS BELONGING TO JOB (J)	DK/MAR 75
				;AND ADD TO LOGICAL NAME TABLE		DK/MAR 75
	EXCH	W,W.SAVE		;YOU CAN COME OUT NOW...		DK/MAR 75
	MOVE	T1,DEVNAM(F)	;PICK UP PHYSICAL NAME
	PUSHJ	P,PUTWDU##	;GIVE HIM THE PHYSICAL NAME
	JRST	SETDD0		;AND SET IT UP

SETDER:	EXCH	W,W.SAVE		;ADJUST STACK				DK/MAR 75
	JRST	ERRDNA		;NOW TAKE THE ERROR WAY OUT		DK/MAR 75
;SUBROUTINE TO CHECK FOR A MATCH BETWEEN THE
;  USER SUPPLIED PARAMETERS AND THE ARGUMENTS IN THE
;  RFC REQUEST QUEUE.   IF THE USER GAVE A NULL IN
;  A PARTICULAR FIELD, THE TEST ON THAT FIELD ALWAYS
;  SUCCEEDS.
;CALL:
;	MOVE	P1,[ABSOLUTE ADDRESS OF THE USER ARGUMENT LIST]
;	MOVE	F,[ADDRESS OF THE IMP DATA BLOCK ADDRESS]
;	MOVE	M,[ R ,, REL ADDR OF HOST FIELD - 1 ]
;	MOVE	P2,[MY SOCKET]
;	PUSHJ	P,CHKREQ
;	  ERROR RETURN	...AT LEAST ONE FIELD FAILED
;	OK RETURN...	NO TESTED FIELD FAILED
CHKREQ:	PUSHJ	P,GETREQ	;GET REQUEST QUEUE ADDRESS
	MOVE	P4,T1		;SAVE POINTER
	pushj	p,g.uuh1	;[96bit] get next word and convert
	jumpe	t1,chkre1	;[96bit] if host is blank, ok
	came	t1,.rqhst(p4)	;[96bit] do the two hosts match?
	  popj	p,		;[96bit] no: no match
chkre1:	trne	p2,1		;[96bit] input?
	  jrst	chkre2		;[96bit] no: don't check byte size
	jumpe	t2,chkre2	;[96bit] if the byte size is blank, ok
	came	t2,.rqbyt(p4)	;[96bit] do the byte sizes match?
	  popj	p,		;[96bit] no: no match
chkre2:
	PUSHJ	P,GETWD1##	;GET FOREIGN SOCKET NUMBER
	HRRI	M,.UUSKT(P1)	;RESET USER POINTER
	JUMPE	T1,CPOPJ1	;OK IF NULL
	MOVE	P3,.rqsoc(P4)	;[96bit] GET REQUEST FIELD
	XOR	T1,P3		;MATCH WITH REQUEST
	TLZ	T1,(<1←4-1>B3)	;DONT TEST HIGH BITS
	JUMPE	T1,CPOPJ1	;JUMP IF OK
	POPJ	P,		;ERROR RETURN
;[96bit] subroutines to deal with the host+imp/byte size word of the
;	 old UUO.  if this is an old format UUO, we "decode" or
;	 "encode" the host and byte size to fit in one word.
;	 if this is not an old format UUO, we put the host word
;	 at the point we're pointing at, and we put the byte size
;	 two words in front of where we're pointing.
;	 if we weren't supporting the old format, we could probably
;	 do this much better by rearranging the calling code.


;[96bit] subroutine to change a word from user format to our format.
;[96bit] output is host number in T1, and byte size in T2

g.uuh1:	hrri	m,1(m)		;[96bit] get the next word
g.uuht:	pushj	p,getwdu##	;[96bit] get the host word
	push	p,t1		;[96bit] save the word
ifn FtOldUUO,<	;[96bit] support old UUO still?
	tlne	p1,(if.new)	;[96bit] is this new format?
	  jrst	g.uunw		;[96bit] this is new format

	;[96bit] old format: must convert this word to host and byte
	ldb	t2,[point 2,t1,35-6]	;[96bit] host number
	lsh	t2,↑d16		;[96bit] shift to where it needs to be
	ldb	t1,[point 6,t1,35]	;[96bit] get imp number
	ior	t1,t2		;[96bit] mash them together
	pop	p,t2		;[96bit] recover the word
	hlrzs	t2		;[96bit] get the byte size alone
	popj	p,		;[96bit] and return

g.uunw:
>;[96bit] 	end of support for old format

	hrri	m,.uubyt-.uuhst(m)	;[96bit] move up to the byte
	pushj	p,getwdu##		;[96bit] get the byte size
	hlrz	t2,t1			;[96bit] store where expected
	hrri	m,.uuhst-.uubyt(m)	;[96bit] return to host word
	jrst	tpopj##			;[96bit] recover host word and
					;	 and return


;[96bit] subroutine to take a host number and byte size, and convert
;	 to user format, and write in user memory.
;	 call:
;	 	move	t1,[host number]
;	 	move	t2,[byte size]
;	 	pushj	p,p.uuht
;	 	only return

p.uuh1:	hrri	m,1(m)			;[96bit] store in the next word
p.uuht:
ifn FtOldUUO,<	;[96bit] if we still support old UUO format
	tlne	p1,(if.new)	;[96bit] new format?
	  jrst	p.uunw		;[96bit] new format
	push	p,t2		;[96bit] save t2
	ldb	t2,[point 2,t1,35-16] ;[96bit] get (what we can of) host
	lsh	t2,6		;[96bit] put in the old position
	andi	t1,77		;[96bit] get just the imp
	ior	t1,t2		;[96bit] mash them together
	pop	p,t2		;[96bit] recover byte size
	hrl	t1,t2		;[96bit] put in proper place
	pjrst	putwdu##	;[96bit] put the word and return
p.uunw:
>;[96bit] 	end of support for old format UUOs

	pushj	p,putwdu##		;[96bit] store the host here
	hrri	m,.uubyt-.uuhst(m)	;[96bit] move up to byte word
	hrlz	t1,t2			;[96bit] set up the byte
	pushj	p,putwdu##		;[96bit] store
	hrri	m,.uuhst-.uubyt(m)	;[96bit] return to host word
	popj	p,			;[96bit] and return
SUBTTL PRIMITIVES

;SUBROUTINES TO GENERATE THE VARIOUS PRIMITIVES OF THE NCP

;SUBROUTINE TO GENERATE AN RFC
;CALL:
;	(FOREIGN HOST BETTER BE IN DBB)
;	MOVE	F,[USER IMP DDB]
;	MOVE	P2,[MY SOCKET(32 BIT)]
;	MOVE	P3,[FOREIGN SOCKET NUMBER]
;	MOVE	T1,[BYTE SIZE]
;	ScnOff
;	PUSHJ	P,PRFC
;	ALWAYS RETURN HERE  --  CLOBBERS ALL BUT F, S.
PRFC:	PUSHJ	P,SETBYT	;SET BYTE SIZE
	MOVE	T1,P3
	TLO	T1,(1B0)	;NON-NULL
	PUSHJ	P,SETHSS	;SET HIS SOCKET NUMBER
	PUSHJ	P,SETMYS	;DEPOSIT MY SOCKET
	MOVEI	T1,.IMRTS
	TRNE	P2,1		;STR?
	MOVEI	T1,.IMSTR	;YES
	PUSHJ	P,OUTXOP	;SEND IT
	MOVE	T1,P2		;MY SOCKET
	PUSHJ	P,OUTX32
	MOVE	T1,P3		;HIS SOCKET
	PUSHJ	P,OUTX32
	TRNE	P2,1		;RECEIVE SOCKET(RTS)?
	JRST	PRFC6		;NO, STR.
				;FALL INTO LINK ASSIGNMENT
;HERE TO FIND A FREE LINK NUMBER.  LINKS ASSIGNED IN ROUND ROBIN MANNER.
	SKIPN	T3,LNKLAS	;GET LAST NUMBER ASSIGNED
	MOVSI	T3,LNKMIN-1	;STORED IN LEFT HALF
	DPB	T3,PILINK	;TO ALLOW THIS
	LDB	T2,PIHOST	;GET HOST NUMBER
	PUSH	P,F		;SAVE DDB ADDRESS
	HLRS	T3
	ADDI	T3,1		;START WITH THE NEXT LINK

;HERE TO TEST A LINK NUMBER IN ALL DDBS
PRFC1:	HRRZ	T1,T3		;TEST THE LINK
	CAILE	T1,LNKMAX	;TOO BIG?
	HRRI	T3,LNKMIN	;YES, START AT LOW END
	HLRZ	T1,T3		;TRIED THEM ALL?
	CAIN	T1,(T3)
	STOPCD	PRFC5,STOP,NFL,	;++NO FREE LINKS
PRFC0:	MOVEI	T4,IMPN		;NUMBER OF IMPS
	MOVEI	F,IMPDDB	;FIRST IMP DDB

;HERE TO TEST A LINK
PRFC2:	LDB	T1,PIHOST	;GET HOST NUMBER
	CAME	T1,T2		;SAME HOST?
	JRST	PRFC3		;NO
	LDB	T1,PILINK	;YES, TEST LINK
	CAIN	T1,(T3)		;IN USE?
	AOJA	T3,PRFC1	;YES, TRY NEXT.

;HERE TO GET NEXT DDB FOR TESTING
PRFC3:	HLRZ	F,DEVSER(F)	;NEXT IN CHAIN
	SOJG	T4,PRFC2	;LOOP IF NOT DONE
PRFC5:	POP	P,F		;RESTORE DDB ADDRESS
	HRLZM	T3,LNKLAS	;SAVE THIS LINK NUMBER
	HRRZ	T1,T3		;GET THE INDICATED LINK
	DPB	T1,PILINK	;PUT IT IN THE DDB
	PJRST	OUTX8		;SEND THE LINK NUMBER

;HERE TO SEND BYTE SIZE
PRFC6:	PUSHJ	P,GETBYT	;GET PROPER BYTE SIZE
	PJRST	OUTX8		;AND SEND IT
;SUBROUTINE TO SEND A CLS
;CALL:
;	MOVE	U,[PROPER NCP OUTPUT DDB]
;	MOVE	P2,[LOCAL SOCKET NUMBER(32 BITS)]
;	MOVE	P3,[HIS SOCKET(32 BITS)]
;	PUSHJ	P,PCLS
;	ALWAYS RETURN HERE
PCLS:	MOVEI	T1,.IMCLS	;SEND CLS MESSAGE
	PUSHJ	P,OUTXOP
	MOVE	T1,P2
	PUSHJ	P,OUTX32
	MOVE	T1,P3		;HIS SOCKET
	PJRST	OUTX32		;SEND IT AND RETURN
;SUBROUTINE TO SEND AN ALLOCATE(ALL)
;CALL:
;	MOVE	U,NCP OUTPUT ADDRESS
;	MOVE	F,DDB ADDRESS
;	MOVE	T1,NUMBER OF BITS TO BE SENT
;	MOVE	T2,NUMBER OF MESSAGES ALLOCATED
;	ScnOff
;	PUSHJ	P,PALL
;	ALWAYS RETURN HERE
PALL:	ADDM	T1,IALBIT(F)	;UPDATE LOCAL ALLOCATION COUNTER
	PUSH	P,T1		;SAVE BIT COUNT
	ADDM	T2,IALMES(F)
	PUSH	P,T2		;SAVE MESSAGE COUNT
	MOVEI	T1,.IMALL	;SEND CODE
	PUSHJ	P,OUTXOP
	LDB	T1,PILINK	;SEND RECEIVE LINK
IFN DEBUG,<
	SKIPN	T1		;MUST BE POSITIVE
	STOPCD	.+1,DEBUG,ALZ,	;++ALLOCATING TO LINK ZERO
>
PALL01:	PUSHJ	P,OUTX8
	POP	P,T1		;RETRIEVE MESSAGE COUNT
	PUSHJ	P,OUTX16	;SEND IT
	POP	P,T1		;BIT COUNT
	PJRST	OUTX32		;SEND AND RETURN

;SUBROUTINE TO SEND A RET(IN RESPONSE TO A GVB)
;CALL:
;	MOVE	U,NCP OUTPUT DDB
;	MOVE	F,DDB ADDRESS
;	MOVE	T1,NUMBER OF BITS
;	MOVE	T2,NUMBER OF MESSAGES TO RETURN
;	PUSHJ	P,PRET
;	ALWAYS RETURN HERE
PRET:	PUSH	P,T1		;SAVE BIT COUNT
	PUSH	P,T2		;SAVE MESSAGE COUNT
	MOVEI	T1,.IMRET	;SEND CODE
	PUSHJ	P,OUTXOP
	LDB	T1,POLINK	;GET OUTPUT LINK
	JRST	PALL01		;SEND AND RETURN
;SUBROUTINE TO SEND A GVB
;CALL:
;	MOVE	F,DDB ADDRESS
;	PUSHJ	P,PGVB
;	ALWAYS RETURN HERE
PGVB:	MOVEI	T1,.IMGVB	;SEND CODE
	PUSHJ	P,OUTXOP
	LDB	T1,PILINK	;GET INPUT LINK
	PUSHJ	P,OUTX8
	MOVEI	T1,↑D128	;100% OF MESSAGES
	PUSHJ	P,OUTX8
	MOVEI	T1,↑D128	;100% OF BITS
	PJRST	OUTX8

;SUBROUTINE TO SEND AN INTERRUPT(INR/INS)
;CALL:
;	MOVE	F,DDB ADDRESS
;	PUSHJ	P,INS(INR)
;	ALWAYS RETURN HERE
PINR:	MOVEI	T1,.IMINR	;SEND CODE
	PUSHJ	P,OUTXOP
	LDB	T1,PILINK	;GET INPUT LINK NUMBER
	PJRST	OUTX8		;SEND IT AND RETURN

PINS:	MOVEI	T1,.IMINS	;SEND CODE
	PUSHJ	P,OUTXOP
	LDB	T1,POLINK	;GET OUTPUT LINK NUMBER
	PJRST	OUTX8
;SUBROUTINES TO SEND AN ECO, ERP, NOP, OR ERR
;CALL:
;	MOVE	U,NCP DDB ADDRESS
;	PUSHJ	P,ECO
;	ALWAYS RETURN HERE
PECO:	PUSH	P,T1		;[96bit] SAVE HOST NUMBER  (we will
				;	 send low order 8 bits of it.)
	MOVEI	T1,.IMECO
	JRST	PERP1

PERP:	PUSH	P,T1		;SAVE DATA
	MOVEI	T1,.IMERP
PERP1:	PUSHJ	P,OUTXOP	;SEND MESSAGE TYPE
	POP	P,T1		;RETRIEVE DATA
	PJRST	OUTX8		;SEND IT AND RETURN

PNOP:	MOVEI	T1,.IMNOP
	PJRST	OUTXOP

PERR:	MOVEI	T1,.IMERR
	PJRST	OUTXOP

PRRP:	MOVEI	T1,.IMRRP
	PJRST	OUTXOP

PRST:	MOVEI	T1,.IMRST
	PJRST	OUTXOP
SUBTTL SUBROUTINES

;OUTPUT ROUTINES

;HERE TO SEND THE OP CODE FOR AN NCP MESSAGE
OUTXOP:	AOS	XMTMES(T1)	;COUNT IT

;HERE TO SEND AN 8 BIT BYTE
OUTX8:	MOVEI	T2,1		;SET MARK BIT
	JRST	OUTXBT		;GET IT

;HERE TO SEND A 16 BIT BYTE
OUTX16:	MOVEI	T2,1
	JRST	OUTX33

;HERE TO SEND A 32 BIT BYTE
OUTX32:	MOVEI	T2,1
	ROTC	T1,-↑D16	;SHIFT INTO POSITION TO SEND
OUTX33:	ROTC	T1,-↑D8		;  HIGH ORDER BYTE
OUTXBT:	PUSHJ	P,SAVE2##	;GET SOME SCRATCH ACS
	EXCH	F,U		;SET UP DDB
	MOVE	P1,T1		;SAVE DATA
	SKIPA	P2,T2		;SAVE FLAG
OUTXB1:	MOVE	T1,P1		;GET CHUNK OF DATA
	JSP	P4,(P4)		;SEND THE BYTE
	  STOPCD OUTXB2,DEBUG,ESB, ;++ERROR STORING BYTE
	TRNE	P2,1		;DONE?
	JRST	OUTXB2		;YES
	ROTC	P1,8		;NO GET NEXT BYTE
	JRST	OUTXB1		;AND SEND IT

;HERE WHEN DONE
OUTXB2:	EXCH	F,U		;RESTORE DDBS
	POPJ	P,

;HERE TO LINK UP THE MESSAGE
OUTXX:	EXCH	F,U		;SET UP DDB ADDRESS
	PUSHJ	P,IMPOXX	;CALL THE ROUTINE
	EXCH	F,U		;RESTORE DDB ADDRESSES
	LDB	T1,OHOSTP	;GET HOST NUMBER
	PUSHJ	P,HOSTGO	;GO
	  STOPCD CPOPJ,DEBUG,NXH, ;++NONEXISTENT HOST
	POPJ	P,
;SUBROUTINE TO SEND AN INTERRUPT ON A SEND LINK.
;CALL:
;	MOVE	F,IMP DATA BLOCK ADDRESS
;	PUSHJ	P,NCPINS
;	ALWAYS RETURN HERE
NCPINS::PUSHJ	P,SAVE4##
	LDB	T1,POHOST	;GET HOST NUMBER
	ScnOff			; lord, protect us from evil
	PUSHJ	P,NDBSTC	;GET A DDB
	PUSHJ	P,PINS		;FORM THE MESSAGE
	pushj	p,OUTXX		;SEND IT
	ScnOn			; restore scnser interrupts
	popj	p,		; and return
;HERE ON CLOCK TICK(1 SECOND)
NCPCLK::MOVEI	F,IMPDDB##	;LOOP THROUGH DDBS
	PUSH	P,[IMPN]
NCPCL2:	ScnOff
	MOVE	T1,IMPIOS(F)	;GET IMP STATUS WORD
	TRNE	T1,EXTMSK	;EXEC SOCKET TIMEOUT IN PROGRESS?
	AOS	T1,IMPIOS(F)	;YES, INCREMENT TIMEOUT COUNT
	TRNE	T1,EXTOVF	;TIMEOUT?
	PUSHJ	P,EXCKIL	;YES, KILL THE CONNECTION
	LDB	T1,PISTAT
	CAIE	T1,.ISOPN	;OPEN?
	JRST	NCPCL4		;NO, DON'T DO ANYTHING
	SKIPE	ITTYC(F)	;YES, IMP INPUT BACKED UP?
	PUSHJ	P,TTYTST##	;YES, SEE IF TTY CONNECTION
	  JRST	.+2		;YES, BUT WITHOUT JOB CONTROL
	  PUSHJ	P,RQIITI##	;JOB CONTROL, ATTEMPT TO RESTART INPUT
	SKIPE	IBFBIT(F)	;ANY UNREALLOCATED INPUT BITS?
	PUSHJ	P,NCPALL	;YES, HANDLE ALLOCATION
NCPCL4:	ScnOn
	HLRZ	F,DEVSER(F)	;LINK TO NEXT DDB
	SOSLE	(P)		;AT END YET?
	JRST	NCPCL2		;NO.  KEEP GOING.
	POP	P,T1		;YES
	SOSLE	TIKHST
	POPJ	P,
	MOVEI	T1,HS.TIK-1	;CHECK EACH HOST EVERY 60 SECONDS
	ADD	T1,HSTCNT	;GET NUMBER OF SECONDS PER HOST
	IDIV	T1,HSTCNT
	MOVEM	T1,TIKHST
	PJRST	HOSTCK		;CHECK A HOST
;ROUTINE TO CLOSE BOTH SIDES OF AN EXEC CONNECTION THAT HAS JUST TIMED OUT
;	PUSHJ	P,EXCKIL
;	ALWAYS RETURN HERE

EXCKIL:	PUSHJ	P,SAVE4##	;GET SOME AC'S
	MOVEI	T1,EXTOVF!EXTBIT ;CLEAR OVERFLOW FLAG AND RESTART THE
	XORM	T1,IMPIOS(F)	;  TIMER.
	AOS	ICPERR		;COUNT NUMBER OF TIMES THIS HAS HAPPENED
	SETZ	P2,		;DO INPUT SOCKET FIRST
	PUSHJ	P,.+2
	MOVEI	P2,1		;NOW OUTPUT SOCKET
	PUSHJ	P,GETSTT	;GET SOCKET STATE
	XCT	EXCKLT(T1)	;DISPATCH ON CURRENT STATE

EXCKLT:	PJRST	CLSS3		;ALREADY CLOSED, MAKE SURE IT'S WIPED
	PJRST	CLSS3		;LISTENING, JUST CLOSE IT
	JRST	EXCKL1		;RFC IN, GO REFUSE IT
	PJRST	CLSS3		;RFC ABORT, JUST CLOSE IT
	JRST	EXCKL2		;RFC WAIT, GO SEND A CLOSE
	JRST	EXCKL2		;OPEN, GO SEND A CLOSE
	PJRST	CLSS3		;CLOSE WAIT, FORCE THE CLOSE
	JRST	EXCKL2		;CLOSE WAIT FOR RFNM, SEND CLOSE ANYWAY
	JRST	EXCKL2		;ICP RFNM WAIT, SEND A CLOSE
	PJRST	CLSS3		;CLOSED WITH DATA, JUST CLOSE IT


;HERE IF IN RFC IN STATE
EXCKL1:	PUSHJ	P,GETREQ	;GET REQUEST POINTER
	move	p1,.rqhst(t1)	;[96bit] get host number
	move	t1,.rqsoc(t1)	;[96bit] get foreign socket
	PUSHJ	P,SETHSS	;PUT THEM IN THE NORMAL PLACE SO THE
	MOVE	T1,P1		;  USUAL CLOSE LOGIC WORKS
	PUSHJ	P,SETHST

;HERE TO SEND 'CLS' TO REMOTE HOST
EXCKL2:	PUSHJ	P,GETMYS	;GET LOCAL SOCKET
	MOVE	P2,T1		;SAVE IT
	PUSHJ	P,GETHSS	;GET FOREIGN SOCKET
	MOVE	P3,T1		;SAVE IT
	PUSHJ	P,GETHST	;GET FOREIGN HOST
	PUSHJ	P,NDBSTC	;SETUP NCP OUTPUT DDB
	PUSHJ	P,GETSTT	;GET PRESENT STATE AGAIN
	CAIE	T1,.ISRMW	;CLOSE RFNM WAIT?
	PJRST	CLSS8		;NO, ENTER CLOSE WAIT STATE AND SEND 'CLS'
	PJRST	CLSS4		;YES, CLOSE NOW AND SEND 'CLS'
;SUBROUTINE TO CHECK ALLOCATION AT ANY
; LEVEL FOR IMPSER ROUTINES.
;CALL:
;	MOVE	F,[DATA BLOCK ADDRESS]]
;	ScnOff
;	PUSHJ	P,NCPALL
;	ALWAYS RETURN HERE
NCPALL::LDB	T1,PISTAT	;IS THE CONNECTION OPEN?
	CAIE	T1,.ISOPN
	POPJ	P,		;NO, DON'T DO ANY ALLOCATION
	PUSHJ	P,SAVE4##	;GET SOME MORE AC'S
	SETZB	T1,T2		;PREPARE TO CLEAR IBFBIT AND IBFMES
	EXCH	T1,IBFBIT(F)	;GET UNREALLOCATED INPUT BITS
	EXCH	T2,IBFMES(F)	;MESSAGES
	PUSHJ	P,IALDEC	;DECREMENT ALLOCATIONS
	LDB	P1,PIALBT	;GET DESIRED INPUT BIT ALLOCATION
	SUB	P1,IALBIT(F)	;COMPUTE BITS TO REALLOCATE
	LDB	P2,PIALMS	;GET DESIRED INPUT MESSAGE ALLOCATION
	SUB	P2,IALMES(F)	;COMPUTE MESSAGES TO REALLOCATE
	CAMG	P1,IALBIT(F)	;BITS MORE THAN 50% USED?
	CAMLE	P2,IALMES(F)	;MESSAGES?
	CAIA			;ONE OF THEM IS, REALLOCATE
	POPJ	P,		;NEITHER IS, FORGET IT
	LDB	T1,PIHOST	;GET HOST NUMBER
	PUSHJ	P,NDBST2	;SETUP OUTPUT DDB, P4
	SKIPG	T1,P1		;GET BITS TO REALLOCATE
	SETZ	T1,
	SKIPG	T2,P2		;MESSAGES
	SETZ	T2,
	PUSHJ	P,PALL		;BUILD THE 'ALL' MESSAGE
	PJRST	OUTXX		;SEND IT


;ROUTINE TO DECREMENT MESSAGE AND BIT ALLOCATIONS BY GIVEN AMOUNTS
;	MOVE	T1,[BIT DECREMENT]
;	MOVE	T2,[MESSAGE DECREMENT]
;	MOVE	F,[IMP DDB ADDRESS]
;	PUSHJ	P,IALDEC (FOR INPUT) OR OALDEC (FOR OUTPUT)
;	ALWAYS RETURN HERE--ONLY T3 AND T4 ARE CLOBBERED

IALDEC:	SKIPA	T3,[IALBIT,,IALMES] ;LOOK AT INPUT ALLOCATIONS
OALDEC:	MOVE	T3,[OALBIT,,OALMES] ;OUTPUT
	PUSHJ	P,.+2		;DO MESSAGES FIRST
	MOVS	T3,T3		;NOW BITS
	EXCH	T1,T2		;EXCHANGE MESSAGES AND BITS
	ADDI	T3,(F)		;INDEX INTO CORRECT DDB
	SUBM	T1,(T3)		;DECREMENT THE ALLOCATION
	MOVNS	T4,(T3)		;CORRECT SIGN
	JUMPGE	T4,.+3		;TOO FAR?
	SETZM	(T3)		;YES, FIX IT
	AOS	BADALL		;COUNT ALLOCATION ERRORS
	POPJ	P,
;ROUTINES TO CHECK IF AN INPUT OR OUTPUT SOCKET IS
;OPEN FOR DATA TRANSFER.
;CALLED FROM UUO LEVEL ONLY
;CALL:
;	PUSHJ	P,NCPICK
;	RETURN HERE IF NOT OPEN
;	RETURN HERE IF OPEN

NCPOCK::PUSH	P,T1
	LDB	T1,POSTAT
	JRST	NCPCK1

NCPICK::PUSH	P,T1
	LDB	T1,PISTAT
	CAIE	T1,.ISCLD	;CLOSED WITH DATA?
NCPCK1:	CAIN	T1,.ISOPN	;OPEN?
	JRST	TPOPJ1##	;YES
	JRST	TPOPJ##


;ROUTINE TO TEST FOR SOCKET IN OPEN OR CLOSE INPUT WAIT STATE, AND
;   CLOSE THE LATTER IF ALL INPUT HAS BEEN READ.
;	ScnOff
;	PUSHJ	P,NCPICL
;	  HERE IF NO DATA LEFT; CLOSE ALREADY DONE
;	HERE IF STILL OPEN OR CLOSED WITH DATA TO BE READ

NCPICL::LDB	T1,PISTAT
	CAIN	T1,.ISOPN	;OPEN?
	  JRST	cpopj1##	;YES
	CAIE	T1,.ISCLD	;CLOSED WITH DATA?
	  popj	p,		;NON-SKIP RETURN
	SKIPE	IBFTHS(F)	;ANY DATA?
	  JRST	cpopj1##	;YES
	PUSHJ	P,SAVE2##	;NO, GET SOME AC'S
	MOVE	P2,ISKLCL(F)	;SETUP LOCAL SOCKET NUMBER
	pjrst	CLSS3		;CLOSE THE SOCKET and return non-skip
;SUBROUTINE TO FIND THE RECIPIENT OF A HOST/LINK PAIR ON THE
;  OUTPUT SIDE.  CALLED ONLY FROM INTERRUPT LEVEL.
;CALL:
;	move	p1,[ host ]		;[96bit]
;	hrl	p2,[ link ]		;[96bit]
;	PUSHJ	P,LNKOSR
;	  ERROR RETURN	...  NOT FOUND
;	OK RETURN  ...	ADDRESS IN F
LNKOSR:	SKIPA	T2,[OLEADR]	;OUTPUT SIDE
LNKISR:	MOVEI	T2,ILEADR	;INPUT SIDE
	hlrz	t1,p2		;[96bit] get link number
	PUSHJ	P,LNKTST##	;TEST IT
	  AOS	BADLNK		;NCP??!!
	  POPJ	P,		;OUT OF RANGE
	DPB	P1,[POINT .szhst,T1,35-.szlnk]
	PJRST	DDBIOS##	;DO THE SEARCH, SKIP OR NON-SKIP


;ROUTINE TO SET THE STANDARD DESIRED ALLOCATIONS FOR TELNET AND
;  DATA CONNECTIONS
;	MOVE	F,[IMP DDB ADDRESS]
;	PUSHJ	P,TLNSET (TELNET) OR DATSET (DATA)
;	ALWAYS RETURN HERE

TLNSET:	SKIPA	T1,[.ALMSL,,.ALBTL] ;SMALL TELNET ALLOCATIONS
DATSET:	MOVE	T1,[.ALMSD,,.ALBTD] ;BIG DATA ALLOCATIONS
	DPB	T1,PIALBT	;STORE DESIRED BIT ALLOCATION
	MOVS	T1,T1
	DPB	T1,PIALMS	;STORE DESIRED MESSAGE ALLOCATION
	POPJ	P,
;SUBROUTINE TO WAIT FOR NCP ACTIVITY.
;CALL:
;  WAITS FOR A CHANGE IN THE STATE.  IT IS UP TO THE CALLING
;  ROUTINE TO DETERMINE IF THE NEW CODE IS PROPER.
;	MOVE	P2,[MY SOCKET]
;	MOVE	T1,STATE CODE
;	MOVE	F,DDB ADDRESS
;	PUSHJ	P,NCSYNC
;	RETURN HERE WITH NEW STATE IN T1
NCSYNC:	HRLM	T1,(P)		;SAVE THE CODE
NCSYN1:	MOVSI	S,ONCPWT
	TRNN	P2,1		;INPUT?
	MOVSI	S,INCPWT	;YES
	IORM	S,IMPIOS(F)	;SET IO ACTIVE
	IORB	S,DEVIOS(F)	;COPY FOR DEVIOS
	PUSHJ	P,GETSTT	;GET CURRENT STATE
	HLRZ	T2,(P)		;GET TEST CODE
	CAIE	T2,(T1)		;SAME?
	JRST	NCSYN2		;NO.
	MOVEI	T1,TIMFLG	;TIMED OUT?
	TDNE	T1,IMPIOS(F)
	JRST	NCSYN2		;YES.
	LDB	T1,PUUTIM	;GET USER WAIT CODE
	CAIGE	T1,1		;NULL?
	MOVEI	T1,3		;YES--DEFAULT (30 SECONDS)
	PUSHJ	P,IMPWAT##	;WAIT
	ScnOff
	JRST	NCSYN1		;TRY AGAIN

;HERE IF WAIT SATISFIED
NCSYN2:	PUSHJ	P,IMPWK1##	;CLEAR FLAGS
	TLNE	W,UU.INT	;INTERRUPTS ALLOWED?
	ScnOn			;YES
	PJRST	GETSTT		;RETURN NEW STATE IN T1


;SUBROUTINE TO SET NCP IO WAIT DONE.  CALLED AT INTERRUPT LEVEL.
;  CLOBBERS T1.   SAVES ALL OTHER ACS.
;CALL:
;	MOVE	P2,[MY SOCKET NUMBER]
;	MOVE	F,[DATA BLOCK ADDRESS]
;	PUSHJ	P,NCPIOD
;	ALWAYS RETURNS HERE
NCPIOD:	MOVSI	T1,ONCPWT
	TRNN	P2,1		;INPUT?
	MOVSI	T1,INCPWT	;YES
	TDNN	T1,IMPIOS(F) 	;WAITING?
	POPJ	P,		;NO
	PJRST	IMPWAK##	;WAKE THE JOB
;SUBROUTINE TO GET A FREE IMP DDB
;CALL:
;	MOVE	J,JOB NUMBER(0 IF NONE YET)
;	ScnOff
;	PUSHJ	P,DDBGET
;	  ERROR RETURN	...NONE FREE
;	OK RETURN...	DDB ADDRESS IN F
DDBGET:	MOVEI	T2,IMPN		;MAXIMUM NUMBER TO CHECK
	MOVEI	F,IMPDDB	;START HERE
	MOVEI	T1,ASSCON!ASSPRG ;FOR ASSIGNMENT TEST
DDBGT1:	LDB	T3,PISTAT	;GET STATE
	JUMPN	T3,DDBGT2	;DONT USE IF NOT CLOSED
	LDB	T3,POSTAT
	JUMPN	T3,DDBGT2
	TDNN	T1,DEVMOD(F)	;ASSIGNED?
	JRST	DDBGT3		;NO
	JUMPE	J,DDBGT2	;IF NO JOB NUMBER, CANT POSSIBLY OWN IT
	LDB	T3,PJOBN##	;GET OWNER JOB NUMBER
	CAMN	T3,J		;MINE?
	JRST	DDBGT4		;YES
DDBGT2:	HLRZ	F,DEVSER(F)	;GET NEXT
	SOJG	T2,DDBGT1	;LOOP IF MORE TO TEST
	POPJ	P,		;NONE FREE.  ERROR RETURN

;HERE WHEN FOUND A DDB
DDBGT3:	DPB	J,PJOBN##	;DEPOSIT JOB NUMBER
DDBGT4:	MOVEI	T1,ASSCON	;ASSIGNED BY CONSOLE BIT
	IORM	T1,DEVMOD(F)	;ASSIGN IT
	PUSHJ	P,CLRIMP	;CLEAR IT
	SETZM	DEVLOG(F)	;ENSURE NO LOGICAL NAME YET
	JRST	CPOPJ1##	;SKIP RETURN
;SUBROUTINE TO RELEASE A DDB.  SHOULD ONLY BE CALLED AFTER
;  CLOSING BOTH SIDES.
;CALL:
;	MOVE	F, [ADDRESS OF DDB]
;	PUSHJ	P,DDBREL
;	ALWAYS RETURN HERE
DDBREL::MOVEI	T2,ASSCON	;DEASSIGN DEVICE.
	PUSHJ	P,RELEA6##
;	JRST	CLRIMP


;SUBROUTINE TO WIPE A DDB
CLRIMP:	PUSHJ	P,IMPWK1##	;CLEAR FLAGS
	MOVE	T1,[IMPCLR,,IMPDDS-1] ;WIPE ALL IMP-SPECIFIC STUFF
;	PJRST	DDBCLR


;ROUTINE TO WIPE ARBITRARY PARTS OF AN IMP DDB
;	MOVE	F,[DDB ADDRESS]
;	MOVE	T1,[FIRST,,LAST]  ;RELATIVE WORDS TO BE ZEROED
;	PUSHJ	P,DDBCLR
;	ALWAYS RETURN HERE--USES T1 AND T2

DDBCLR:	ADDI	T1,(F)		;MAKE FINAL ADDRESS ABSOLUTE
	HLRZ	T2,T1		;GET RELATIVE FIRST ADDRESS
	ADDI	T2,1(F)		;MAKE IT ABSOLUTE AND ADD ONE
	HRLI	T2,-1(T2)	;MAKE ABSOLUTE FIRST,,FIRST+1
	SETZM	-1(T2)		;CLEAR FIRST WORD
	BLT	T2,(T1)		;CLEAR REST
	POPJ	P,
;SUBROUTINES TO SET UP AND CLEAR THE NCP OUTPUT DDB
;CALL:
;	PUSHJ	P,NDBST-
;	ALWAYS RETURN HERE

;CLOCK INTERRUPT LEVEL
NDBSTC:	MOVEI	U,NCPODC	;CLOCK DDB
	JRST	NDBST1

;IMP UUO LEVEL
NDBSTU:	MOVEI	U,NCPODU
	JRST	NDBST1

;IMP INTERRUPT LEVEL
NDBSTI:	MOVEM	P4,INBGET	;SAVE INPUT LINKAGE
	move	T1,P1		;[96bit] SET HOST NUMBER IN T1
NDBST2:	MOVEI	U,NCPODI
NDBST1:	MOVEI	P4,OUBYTE##	;ADDRESS OF OUTPUT ROUTINE
	SETZM	OLEADR(U)
	MOVSI	T2,OLEADR(U)	;CLEAR THE OUTPUT PORTION OF THE DDB
	HRRI	T2,OLEADR+1(U)
	BLT	T2,OLEADR+OBFWDS-1(U)
	DPB	T1,OHOSTP	;DEPOSIT IN NCP DDB
	POPJ	P,


;[96bit] pointer to HOST NUMBER IN NCP DDB
OHOSTP:	POINT	.szhst,OLEADR(U),35-.szlnk
;ROUTINE TO MAKE A LOCAL SOCKET NUMBER FOR A USER'S IMPUUO.
;	MOVE	P1,[IMPUUO ARGUMENT WORD]
;	MOVE	P2,[LOCAL SOCKET AS SUPPLIED BY USER]
;	MOVE	J,[JOB NUMBER]
;	MOVE	F,[IMP DDB ADDRESS]
;	PUSHJ	P,MAKMYS
;	  ERROR--DUPLICATE OR UNAVAILABLE LOCAL SOCKET NUMBER
;	OK--FULL LOCAL SOCKET NUMBER IN P2

MAKMYS:	JUMPL	P2,MAKMY5	;REQUESTING ANY OLD FREE SOCKET?
	HRRZ	T1,JBTPPN##(J)	;NO, GET PROGRAMMER NUMBER
	TRNE	P2,SK.JOB	;DID HE WANT JOB NUMBER?
	HRRZ	T1,J		;USE JOB NUMBER
	TLNN	P1,(IF.ALS)	;USER WANT ABSOLUTE LOCAL SOCKET?
	DPB	T1,[POINT 27,P2,26] ;NO, MAKE IT USER- OR JOB-RELATIVE
	PUSH	P,F		;SAVE DDB POINTER
	MOVEI	T4,(F)		;MAKE A COPY AND CLEAR SOCKET USE FLAG
	MOVEI	F,IMPDDB##	;SEARCH ALL DDB'S
	MOVEI	T3,IMPN##
MAKMY0:	MOVE	T1,ISKLCL(F)	;NO, GET INPUT SOCKET
	XOR	T1,P2		;SAME AS USER-SUPPLIED SOCKET?
	CAIE	F,(T4)		;  AND DIFFERENT DDB?
	JUMPE	T1,FPOPJ	;YES, ERROR
	MOVE	T2,OSKLCL(F)	;NO, GET OUTPUT SOCKET
	XOR	T2,P2		;SAME AS USER-SUPPLIED SOCKET?
	CAIE	F,(T4)		;  AND DIFFERENT DDB?
	JUMPE	T2,FPOPJ	;YES, ERROR
	TDNE	T1,[-1-SK.LCL]	;NO, IN SAME RANGE AS USER-SUPPLIED SOCKET?
	TDNN	T2,[-1-SK.LCL]
	TLNN	P1,(IF.ALS)	;YES, DID USER ASK FOR AN ABSOLUTE SOCKET?
	JRST	MAKMY1		;NO OR RANGE DOESN'T MATCH, CONTINUE
	LDB	T1,PJOBN##	;YES, DOES SOCKET BELONG TO THIS JOB?
	CAIN	T1,(J)
	HRLI	T4,-1		;YES, REMEMBER USER OWNS A SOCKET IN RANGE
MAKMY1:	HLRZ	F,DEVSER(F)	;CHAIN TO NEXT DDB
	SOJG	T3,MAKMY0	;MORE?
	TLNE	P1,(IF.ALS)	;NO, DID USER ASK FOR AN ABSOLUTE SOCKET?
	TLNE	P1,(IF.PRV)	;YES, IS HE PRIVILEGED?
FPOPJ1:	AOSA	-1(P)		;PRIVILEGED OR DIDN'T WANT ABSOLUTE--OK
	JUMPL	T4,.-1		;ELSE OK IFF ALREADY OWN SOCKET IN SAME RANGE
FPOPJ:	POP	P,F		;RESTORE DDB POINTER
	POPJ	P,

;HERE IF USER-SUPPLIED ARGUMENT IS NEGATIVE, MEANING WANT A FREE SOCKET
;  RANGE ALLOCATED.
MAKMY5:	PUSHJ	P,FRESKT	;FIND A FREE SOCKET
	ANDI	P2,SK.LCL	;MASK USER-SPECIFIED PORTION
	IOR	P2,T1		;BUILD COMPLETE SOCKET
	JRST	CPOPJ1##	;GIVE NORMAL RETURN
;ROUTINE TO ALLOCATE A FREE SOCKET RANGE
;	PUSHJ	P,FRESKT
;	ALWAYS RETURN HERE, WITH FIRST SOCKET IN RANGE IN T1.

FRESKT:	AOS	T1,SKTNUM	;ADVANCE SOCKET NUMBER GENERATOR
	ANDI	T1,FREMSK	;MASK TO WIDTH WANTED
	LSH	T1,FRELSH	;POSITION THE BITS
	ADD	T1,[FREMIN]	;OFFSET FROM START
	MOVE	T2,T1		;MAKE A COPY
	ADDI	T2,SK.LCL	;COMPUTE LAST SOCKET IN RANGE
	MOVEI	T3,IMPN##	;START IMP COUNTER
	MOVEI	T4,IMPDDB##	;SEARCH ALL IMP DDB'S
FRESK1:	CAMG	T1,ISKLCL(T4)	;INPUT SOCKET IN RANGE?
	CAMGE	T2,ISKLCL(T4)
	CAIA			;NO
	JRST	FRESKT		;YES, DISCARD AND TRY AGAIN
	CAMG	T1,OSKLCL(T4)	;OUTPUT SOCKET IN RANGE?
	CAMGE	T2,OSKLCL(T4)
	CAIA			;NO
	JRST	FRESKT		;YES, DISCARD AND TRY AGAIN
	HLRZ	T4,DEVSER(T4)	;LOOP THRU ALL DDB'S
	SOJG	T3,FRESK1
	POPJ	P,		;HERE WHEN FOUND FREE SOCKET RANGE.


COMMENT \
		NOTE ON ALLOCATION OF LOCAL SOCKET NUMBERS

00000000XXX		SERVER ICP SOCKETS (RESERVED TO EXEC)
UUUUUUUUNXX  (N .LE. 3)	USER-RELATIVE SOCKETS FOR USER UUUUUUUU
00000JJJNXX  (N .GE. 4)	JOB-RELATIVE SOCKETS FOR JOB JJJ
00001KKKNXX  (N .GE. 4)	POOL FROM WHICH FREE SOCKETS ARE ALLOCATED FOR BOTH
			USERS AND EXEC SERVER TELNET SOCKETS.  A USER
			REQUESTS ONE OF THESE SOCKETS BY SUPPLYING A NEGATIVE
			LOCAL SOCKET NUMBER.  THE GENERATED SOCKET NUMBER
			IS SUCH THAT SOCKETS 00001KKK400 TO 00001KKK777 ARE
			GUARANTEED TO BE UNUSED.
\
;SUBROUTINE TO SET THE NEW STATE OF A SOCKET
;CALL:
;	MOVE	T1,[NEW STATE]
;	MOVE	P2,[LOCAL SOCKET NUMBER]
;	MOVE	F, [DDB ADDRESS]
;	PUSHJ	P,SETSTT
;	ALWAYS RETURN HERE
SETSTT:	TRNN	P2,1		;SKIP IF OUTPUT
	SKIPA	T2,[XWD DVIN,PISTAT]
	MOVE	T2,[XWD DVOUT,POSTAT]
	DPB	T1,(T2)		;SET THE NEW STATE CODE
	TRZ	T2,-1		;USE LEFT HALF FLAG
	ANDI	T1,STTMSK	;JUST LOOK AT STATE
	CAIN	T1,.ISCLS	;CLOSED?
	JRST	SETST1		;YES
IFE FTAIMP,<
	CAIN	T1,.ISOPN	;IS IT OPEN?
	IORM	T2,DEVMOD(F)	;YES, SET BIT
	POPJ	P,
>
IFN FTAIMP,<
	CAIE	T1,.ISOPN	;IS IT OPEN?
	POPJ	P,		;NO, DONE
	IORM	T2,DEVMOD(F)	;YES, SET BIT
	JRST	SETSTX		;GO RECORD IN ACCTNG
>

;HERE IF SOCKET IS TO BE CLOSED
SETST1:	ANDCAM	T2,DEVMOD(F)	;CLEAR THE BIT
	PUSHJ	P,GETBUF	;GET BUFFER STRING
	SKIPE	T2,T1		;ANYTHING THERE?
	PUSHJ	P,RELBUF##	;RECLAIM THE SPACE
	TRCE	P2,1		;INPUT?
	SKIPA	T1,[OCLEAR,,OCLEND] ;NO, SET OUTPUT POINTERS
	MOVE	T1,[ICLEAR,,ICLEND] ;YES, SET INPUT POINTERS
	PUSHJ	P,DDBCLR	;WIPE INPUT OR OUTPUT SIDE OF IMP
	PUSHJ	P,GETSTT	;GET STATE OF OTHER SIDE
	TRC	P2,1
	JUMPN	T1,SETST2	;IS IT CLOSED TOO?
	ScnOn			; surrender lock for ImpSer
	PUSHJ	P,ITYREL##	;GIVE UP ITY IF HAVE ONE
	PUSHJ	P,TTIDET##	;DISCONNECT CROSSPATCHED TTY IF THERE IS ONE
	ScnOff			; get lock back
	PUSHJ	P,DDBREL	;RELEASE THE DDB
SETST2:	MOVEI	T1,.ISCLS	;RESTORE T1
IFN FTAIMP,<						;DK/OCT 75
SETSTX:	PUSH	P,T1		;PRESERVE CODE
	LDB	T1,POHOST	;WHILE BUILDING ENTRY INFO - HOST #
	PUSHJ	P,IPDNUM	;AND IMP NUMBER - FOR ACCTNG
	HRL	T1,T2
	MOVE	T2,(P)		;ALSO INCLUDE CODE IN ENTRY
	DPB	T2,IFTCOD
	PUSHJ	P,IFENTR	;MAKE ENTRY
	POP	P,T1		;AND RESTORE
>;END IFN FTAIMP
	POPJ	P,
;ACCOUNTING SUBROUTINES				DK/OCT 75

;SURBOTUNES TO HANDLE THE ACCOUTNING BUFFER IN COMMON,
; RECORDING INFORMATION FOR LATER USE BY DAEMON OR SIMILAR
; PROGRAM. ALSO INCLUDED HERE IS THE ROUTINE WHICH IS CALLED
; TO TRANSFER THE BUFFER TO THE USER PROGRAM FOR RECORDING
; IN THE FACT FILES.

IFN FTAIMP,<

;SUBROUTINE TO GET CURRENT IMP NUMBER IN BINARY, RETURNS IN T2.
; CLOBBERS T3, RESPECT T1. F MUST BE ST UP.

IPDNUM:	HRLZ	T3,DEVNAM(F)	;GET NN PART OF IMPNN PHYSICAL NAME
	SETZ	T2,
IPDNMC:	LSH	T3,3		;CONVERT ONE DIGIT FROM 6BIT TO OCT
	LSHC	T2,3		;AND INCLUDE
	JUMPN	T3,IPDNMC	;WHILE THE SUPPLY LASTS
	POPJ	P,

;SUBORUTINE TO CALCULATE NEXT ENTRY LOC IN THE  CIRCULAR BUFFER
; IN COMMON. OLD VALUE IN T3, NEW VALUE RETURNED IN T3. ALWAYS
; POINTS TO START OF ENTRY IN BOTH CASES.

IFECLC:	ADDI	T3,IFCESZ##	;SIZE OF ENTRY
	CAIG	T3,IFCTEF##	;END ADDRESS
	POPJ	P,		;STILL OK
	MOVEI	T3,IFCTBF##	;BACK TO BEGINNING
	POPJ	P,

;STILL IN FTAIMP
;SUBROUTINE TO ADD AN ENTRY TO THE FACT/ACCTNG BUFFER. ARG
; IN T1:
;	0-3	STATUS CODE
;	4-17	IMP NUMBER
;	18-35	HOST NUMBER

;IN THE BUFFER, WORD 0 WILL CONTAIN:

;	0-3	STATUS:	0 - CLOSE
;			5 - OPEN
;			17 - SYSTEM RESET
;	4-11	IMP NUMBER
;	12-19	JOB NUMBER
;	20-31	HOST NUMBER
;	32-35	(EXPANSION)
; (THE TTY NUMBER IS NOT NEEDED AND HAS BEEN SACRIFICED.)

;WORD 1 CONTAINS THE P,PN
;WORD 2 CONTAINS DATE/TIME IN UNIVERSAL FORMAT

IFENTR:	MOVE	T3,IFCTNL##	;GET ADDRESS OF NEXT ENTRY
	LDB	T2,IFTCOD	;GET CODE FROM T1
	DPB	T2,IFPCDB	;AND PUT IN ENTRY
	HLRZ	T2,T1		;GET IMP NUMBER
	DPB	T2,IFPIMP
	LDB	T2,PJOBN##	;GET A JOB NUMBER, IN CASE DONE AT INT. LEVEL
	DPB	T2,IFPJOB	;DEPOSIT JOB NUMBER
	DPB	T1,IFPHST	;HOST NUMBER
	MOVE	T1,JBTPPN##(T2)	;GET PPN OF USER
	MOVEM	T1,1(T3)	;AND PUT AWAY
	MOVE	T1,DATE##	;GET DATE/TIME
	MOVEM	T1,2(T3)
	PUSHJ	P,IFECLC	;CLAC NEXT NEW LOC (T3 SET UP)
	MOVEM	T3,IFCTNL##
	AOS	IFCTCT##	;COUNT OF ENTRIES
	SKIPN	(T3)		;IF NEW LOC POINTS TO UNUSED ENTRY
	POPJ	P,		;ALL CLEAR
	MOVE	T3,IFCTOL##	;ELSE GET OLDEST LOC
	PUSHJ	P,IFECLC	;AND MOVE IT FORWARD
	MOVEM	T3,IFCTOL##
	MOVEI	T1,IFCTSZ##	;ADJUST COUNT
	MOVEM	T1,IFCTCT##	;TO PERMITTED MAX.
	POPJ	P,

;POINTERS

IFTCOD:	POINT	4,T1,3	;POINT TO CODE IN T1

;THESE POINTERS ASSUME T3 LOADED WITH NEXT LOC ADDRESS

IFPCDB:	POINT	4,(T3),3	;STATUS CODE
IFPIMP:	POINT	8,(T3),11	;IMP NUMBER
IFPJOB:	POINT	8,(T3),19	;JOB NUMBER
IFPHST:	POINT	12,(T3),31	;HOST NUMBER (PERMITS EXPANSION)

;STILL IN FTAIMP
;ROUTINE TO PROCESS FUNCTION .IUACT - TRANSFER BUFFER TO USER
; CORE. TURNS ALL INTERRUPTS OFF WHILE DOING SO. BUFFER IS
; ARRANGED FROM OLDEST TO NEWEST ENTRY, STARTING AT THE LOC
; GIEN IN THE RIGHT HALF OF THE USER ARG TO IMPUUO. VALUE RETURNED
; IN USER AC IS COUNT OF ENTRIES. BUFFER IS REINITIALIZED.

IACTS:	CONO	PI,PIOFF##	;PEACE AND QUIET
	SKIPN	T3,IFCTOL##	;GET OLDEST ENTRY
	JRST	IACTS2		;...IF THERE IS ANY
	HRR	M,(P1)		;GET ADDR IN USER CORE
	SOS	M		;FOR LATER AOS

IACTS1:	CAMN	T3,IFCTNL##	;REACHED THE END OF THE LINE?
	JRST	IACTS2		;..YES....
	MOVE	T1,(T3)		;GET A WORD
	PUSHJ	P,PUTWD1##	;PUT IT AWAY
	MOVE	T1,1(T3)	;REPEAT FOR ALL 3 WORDS OF ENTRY
	PUSHJ	P,PUTWD1##
	MOVE	T1,2(T3)
	PUSHJ	P,PUTWD1##
	PUSHJ	P,IFECLC	;CALCULATE NEXT IN BUFFER
	JRST	IACTS1

IACTS2:	MOVE	T1,IFCTCT##	;GET NUMBER OF ENTRIES
	PUSHJ	P,STOTAC##	;AND RETURN AS VALUE IN AC
	MOVEI	T1,IFCTBF##	;RESET POINTERS
	MOVEM	T1,IFCTNL##
	MOVEM	T1,IFCTOL##
	SETZM	IFCTCT##
	MOVE	T1,[IFCTBF##,,IFCTBF##+1]
	SETZM	IFCTBF##
	BLT	T1,IFCTEF##	;CLEAR BUFFER
	CONO	PI,PI.ON	;ALL DONE
	JRST	CPOPJ1##	;GIVE GOOD RETURN
> ;END IFN FTAIMP

GETSTT:	JSP	T2,GETSET	;GET STATE CODE
	LDB	T1,PISTAT
	LDB	T1,POSTAT

GETSTS:	JSP	T2,GETSET	;GET SOCKET STATUS
	MOVE	T1,ISTAT(F)
	MOVE	T1,OSTAT(F)

REPEAT 0,<	;THESE ROUTINES APPEAR NOT TO BE USED
SETSTS:	IFN DEBUG,<ANDI T1,-1>
	JSP	T2,GETSET	;SET STATUS BITS
	IORB	T1,ISTAT(F)
	IORB	T1,OSTAT(F)

CLRSTS:	IFN DEBUG,<ANDI T1,-1>
	JSP	T2,GETSET	;CLEAR STATUS BITS
	ANDCAM	T1,ISTAT(F)
	ANDCAM	T1,OSTAT(F)
> ;END REPEAT 0

REPEAT 0,<	;SOMEDAY THE INTERRUPT FACILITY WILL BE MADE TO WORK
SETINT:	JSP	T2,GETSET	;SET INTERRUPT TRAP ADDRESS
	HRRM	T1,INTRPT(F)
	HRLM	T1,INTRPT(F)
>

SETBYT:	JSP	T2,GETSET	;SET BYTE SIZE
	DPB	T1,PIBYTE
	DPB	T1,POBYTE

GETBYT:	JSP	T2,GETSET	;GET BYTE SIZE
	LDB	T1,PIBYTE
	LDB	T1,POBYTE

GETBUF:	JSP	T2,GETSET	;DATA BUFFERS
	HRRZ	T1,IBFTHS(F)
	HRRZ	T1,OBFFST(F)
GETHST:	JSP	T2,GETSET	;REMOTE HOST NUMBER
	LDB	T1,PIHOST
	LDB	T1,POHOST

SETHST:	JSP	T2,GETSET
	DPB	T1,PIHOST
	DPB	T1,POHOST

GETLNK:	JSP	T2,GETSET
	LDB	T1,PILINK
	LDB	T1,POLINK

GETREQ:	JSP	T2,GETSET
	MOVEI	T1,IRFCQ(F)
	MOVEI	T1,ORFCQ(F)

GETMYS:	JSP	T2,GETSET
	MOVE	T1,ISKLCL(F)
	MOVE	T1,OSKLCL(F)

SETMYS:	TLZ	P2,(<1←4-1>B3)	;32 BIT MY SOCKET
	JSP	T2,GETSET
	MOVEM	P2,ISKLCL(F)
	MOVEM	P2,OSKLCL(F)

GETHSS:	JSP	T2,GETSET
	MOVE	T1,ISKRMT(F)
	MOVE	T1,OSKRMT(F)

SETHSS:	JUMPE	T1,SETHS1	;ZERO SOCKET IS REALLY A NULL
	TLZ	T1,(<1←4-1>B3);32 BITS
	TLO	T1,(1B0)	;STANDARD BIT
SETHS1:	JSP	T2,GETSET	;SET HIS SOCKET
	MOVEM	T1,ISKRMT(F)
	MOVEM	T1,OSKRMT(F)

REPEAT 0,<	;THIS ROUTINE APPEARS NOT TO BE USED
SETLDR:	JSP	T2,GETSET	;SET THE LEADER FIELD
	MOVEM	T1,ILEADR(F)
	MOVEM	T1,OLEADR(F)
>

;HERE TO EXECUTE THE APPROPRIATE INSTRUCTION.
GETSET:	TRNE	P2,1		;OUTPUT SIDE?
	ADDI	T2,1		;YES, USE SECOND INSTRUCTION.
	XCT	(T2)
	POPJ	P,
	SUBTTL	NCP DATA BASE AND IMP SYSTEM STATISTICS

;IMP SYSTEM STATISTICS -- GETTAB TABLE -1 (WITH SUBTABLES)

	SALL
DEFINE SUBTBL(USR,SYS) <
	<.NT'USR-1>B8 + SYS-IMPGTT
>

	$LOW

IMPGTT::SUBTBL	RNM,RECMES	; 0  %ISRNM  RECEIVED NCP MESSAGES BY TYPE
	SUBTBL	XNM,XMTMES	; 1  %ISXNM  TRANSMITTED NCP MESSAGES BY TYPE
	SUBTBL	NEM,ERRTYP	; 2  %ISNEM  REC'D NCP ERROR MESSAGES BY TYPE
	SUBTBL	NMF,NCPFLT	; 3  %ISNMF  NCP MESSAGE FAULTS
	SUBTBL	HMS,SIZHST	; 4  %ISHMS  HISTOGRAM OF REC'D DATA
				;	      MESSAGE SIZES
	SUBTBL	IHM,MESTYP	; 5  %ISIHM  IMP-HOST MESSAGES, BY TYPE
	SUBTBL	DMF,IMPFLT	; 6  %ISDMF  IMP DATA MESSAGE FAULTS
	SUBTBL	BHS,IBFSTT	; 7  %ISBHS  IMP BUFFER HANDLING STATISTICS
	SUBTBL	NED,ERRDAT	;10  %ISNED  NCP ERROR MESSAGE DATA
	subtbl	epl,EPLcnt	; 11  %isepl  error in previous leader
				; messages recieved, by error type
	subtbl	inc,INCcnt	;(234) 12 %isinc incomplete transmission
				;(234) Like a RFNM only error in
				;(234) transmission

;*** ADD MORE GETTAB SUBTABLE POINTERS HERE ***
;FOLLOWING ENTRIES ARE STILL IN THE IMP GETTAB TABLE BUT NOT AT
;  FIXED POSITIONS.  THE USER MUST GET THE PROPER SUBTABLE POINTER
;  FROM THE SET ABOVE, THEN ADD THE DESIRED INDEX INTO THE SUBTABLE.

NCPDAT::
;SUBTABLE 0  %ISRNM  RECEIVED NCP MESSAGES.  INDEX BY MESSAGE TYPE.
RECMES:	BLOCK	<.NTRNM==.IMMAX+1>

;SUBTABLE 1  %ISXNM  TRANSMITTED NCP MESSAGES.  INDEX BY MESSAGE TYPE.
XMTMES:	BLOCK	<.NTXNM==.IMMAX+1>

;SUBTABLE 2  %ISNEM  RECEIVED NCP ERROR MESSAGES.  INDEX BY MESSAGE CODE
ERRTYP:	BLOCK	<.NTNEM==ERRMAX+1>

;SUBTABLE 3  %ISNMF  NCP MESSAGE FAULTS.  INDEX BY ITEM NUMBER
NCPFLT:
NORFNM:	BLOCK	1	; 0  %ISLNR  COUNT OF LOST NCP RFNMS
EXRFNM:	BLOCK	1	; 1  %ISUNR  COUNT OF UNEXPECTED NCP RFNMS (DISCARDED)
BADALL:	BLOCK	1	; 2  %ISALV  COUNT OF ALLOCATION VIOLATIONS
BADLNK:	BLOCK	1	; 3  %ISBLN  COUNT OF BAD LINK NUMBERS IN NCP MSGS
BADDDB:	BLOCK	1	; 4  %ISSNF  COUNT OF SOCKET NOT FOUND ERRORS
BADSTT:	BLOCK	1	; 5  %ISIPS  COUNT OF IMPROPER STATE ERRORS
ILLMES:	BLOCK	1	; 6  %ISINM  COUNT OF ILLEGAL NCP MESSAGE TYPES
ALLDAT:	BLOCK	1	; 7  %ISLDA  LINK,,HOST OF LAST DISCARDED ALLOCATION
ICPERR:	BLOCK	1	; 10 %ISTIC  TIMED-OUT ICP'S
	.NTNMF==.-NCPFLT
;SUBTABLE 4  %ISHMS  HISTOGRAM OF RECEIVED DATA MESSAGE SIZES.
;		     INDEX BY POWER OF 2
SIZHST::BLOCK	<.NTHMS==↑D24>

;SUBTABLE 5  %ISIHM  IMP-HOST MESSAGE COUNTS.  INDEX BY MESSAGE TYPE
MESTYP::BLOCK	<.NTIHM==mesdln>

;SUBTABLE 6  %ISDMF  DATA MESSAGE FAULTS.  INDEX BY ITEM NUMBER
IMPFLT:
BADIMP::BLOCK	1	; 0  %ISIHF  IMP INTERFACE HARDWARE FAULTS
BDMDDB::BLOCK	1	; 1  %ISLNF  LINK NOT FOUND
BDMLNK::BLOCK	1	; 2  %ISBDL  BAD DATA LINK NUMBERS
BDMMES::BLOCK	1	; 3  %ISBMT  BAD MESSAGE TYPES
BDMRFM::BLOCK	1	; 4  %ISDDR  DISCARDED DATA RFNMS
NODRFM::BLOCK	1	; 5  %ISSDR  SIMULATED (TIMED OUT) DATA RFNMS
SIZERR::BLOCK	1	; 6  %ISBMS  BAD MESSAGE SIZE ERRORS
	.NTDMF==.-IMPFLT

;SUBTABLE 7  %ISBHS  IMP BUFFER HANDLING STATISTICS.  INDEX BY ITEM NUMBER
IBFSTT:
BUFERR::BLOCK	1	; 0  %ISIBO  IMP BUFFER OVERRUNS (RAN OUT OF BUFFERS)
BUFNUM::BLOCK	1	; 1  %ISNFB  NUMBER OF FREE BUFFERS
BUFAVG::BLOCK	1	; 2  %ISAFB  10↑4 * AVERAGE BUFFER UTILIZATION
	.NTBHS==.-IBFSTT

;SUBTABLE 10  %ISNED  NCP ERROR-MESSAGE DATA FROM MOST RECENT ERROR
ERRDAT:	BLOCK	3	; 0-2 %ISED1-%ISED3  ERROR DATA FROM MESSAGE
			;	     (10 8-BIT BYTES)
ERRSHN:	BLOCK	1	; 3  %ISSHN  SENDING HOST NUMBER
			; 	     (error code in high 8 bits)
	.NTNED==.-ERRDAT

;[96bit] subtable 11 %isEPL	gives count of error in previous leader
; messages received from IMP, broken into error codes.
EPLcnt::block	1	; 0  %isec0	error flip-flop set
	block	1	; 1  %isec1	message too small ( < 80 bits)
	block	1	; 2  %isec2	message of illegal type.
	block	1	; 3  %isec3	message in wrong format:
	; expansions should go here.
EPLmax==:.-EPLcnt	; the highest number we know about
	block	1	; ?  %isecu	unknown error code
.ntEPL==.-EPLcnt

					; expected new style and got old
;(234) subtable 12 %isINC	gives count of incomplete transmission
; messages received from IMP, broken down into error codes.
INCcnt::block	1	; 0 %isin0	Dest Host didn't accept quickly
			;		enough
	block	1	; 1 %isin1	Message too long
	block	1	; 2 %isin2	Host took to long to transmit
			;		message to IMP
	block	1	; 3 %isin3	Message lost in network due to
			;		IMP or circuit failures
	block	1	; 4 %isin4	IMP couldn't accept the entire
			;		message within 15 sec because of
			;		unavailable resources
	block	1	; 5 %isin5	Source IMP I/O failure
INCmax==:.-INCcnt	; Max length of table
	block	1	; Unknown error codes
.ntINC==.-INCcnt

	XP .ISMXL, <<.-IMPGTT-1>←9>	;LENGTH OF GETTAB TABLE, FOR UUOCON
;TEMPORARY STORAGE
INBGET:	BLOCK	1	;INPUT BYTE GETTING COROUTINE ADDRESS
HSTLAS:	BLOCK	1	;TABLE ENTRY ADDRESS FOR LAST HOST TO TRANSMIT
TIKHST:	BLOCK	1	;SECONDS TO GO BEFORE NEXT HOST TO BE CHECKED
LASCHK:	BLOCK	1	;TABLE ENTRY ADDRESS FOR LAST HOST TO BE CHECKED
LNKLAS:	BLOCK	1	;LAST LINK NUMBER ASSIGNED

HOSTS:	BLOCK	.htsiz+2	;[96bit] start of HOST TABLE.
			;  CONTAINS FLAGS AND OUTPUT
			;  QUEUE FOR NCP LINK OUTPUT TO EACH HOST.
			;  TWO WORDS PER HOST.  THIRD WORD
			;  HAS POINTER TO NEXT SEGMENT OF THE LIST.
			;  SEE COMMENTS IN HOST TESTING SECTION FOR
			;  MORE DETAIL.
HSTCNT:	BLOCK	1	;COUNT OF HOSTS IN THE TABLE (ABOVE)
SKTNUM:	BLOCK	1	;COUNTER FOR GENERATING FREE SOCKET NUMBERS

;DDBS FOR THE NCP

NCPID1:	BLOCK IBFWDS		;NCP INPUT DDB

NCPOD1:	BLOCK OBFWDS		;NCP OUTPUT DDBS
NCPOD3:	BLOCK OBFWDS
NCPOD4:	BLOCK OBFWDS

XP NCPIDB,NCPID1-IBFWD
NCPODI=NCPOD1-OBFWD
NCPODC=NCPOD3-OBFWD
NCPODU=NCPOD4-OBFWD

	MNCPDB==:NCPDAT-.	;NEG # OF WORDS IN NCP DATA BASE
NCPLIT:	$LIT
NCPEND:	END